home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / mapl0301.zip / MBS30301.MRG < prev    next >
Text File  |  1993-04-13  |  102KB  |  2,603 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB3.BAS to produce E:\RBBS\CHAT\RBBSSUB3.BAS
  3. * E:\RBBS\STOCK\RBBSSUB3.BAS:  Date 6-20-1992  Size 129071 bytes
  4. * ------------[ Created 03-01-1993 19:14:55 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB3.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB3.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  AllCaps         58050 Convert a string to all upper case characters
  23. '  AMorPM          41498 Calculate the current time as AM or PM
  24. '  AskGraphics     43004 Determine users graphic default
  25. * ------[ first line different ]------
  26. '  BadFile         20841 Check for system crash attempt with bad device name 'Pe 09/11/91
  27. '  Carrier         42000 Test for whether to continue in RBBS
  28. '  CheckTime       58070 Test to insure that users don't exceed their time
  29. '  CheckCarrier    42005 Checks whether still have carrier
  30. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  31. '  CheckTimeRemain 41007 Set up to log off if time exceeded  'Lk 10/24/91
  32. '  CommInfo        44020 Get users baud rate and parity in a string format
  33. '  CountLines      58160 Count categories a file can be classified into
  34. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  35. '  DelayTime       50495 Wait number of seconds specified before returning
  36. '  DispCall        57001 Display callers file
  37. '  DispTimeRemain  41032 Compute and display time remaining
  38. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  39. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  40. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  41. '  FindLast        58600 Finds last occurence of a string in a string
  42. '  FlushKeys       35000  Completely flush all user input
  43. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  44. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  45. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  46. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  47. '  InitIBM         30000 Open/create NetBIOS semaphore file
  48. '  AddCommas       58130 Format commands in the command prompt
  49. '  Library         21105 Provide support for "library" drives
  50. '  LinesInFile     58161 Counts lines in a file
  51. '  LoadNew         58140 Find the latest uploads
  52. '  ModemPut        52070 Write a modem command string to the modem
  53. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  54. '  OpenMsg         30500 Open the messages file as file number 1
  55. '  PageUp          33202 Display user info. on local screen for ZSysop
  56. '  ReadProf        44000 Read user's profile on return from a "door"
  57. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  58. '  SetOpts         58100 Set correct prompt line for each subsystem
  59. '  SortString      58120 Sort characters in a string
  60. '  TimeRemain      41010 Compute time remaining in minutes
  61. '  UpdtUpload      20705 Updates upload directory file
  62. '  WildFile        20290 Determines whether string matches a pattern
  63. '  XferType        21600 Identify the file transfer protocol
  64. '
  65. '  $INCLUDE: 'RBBS-VAR.BAS'
  66. '
  67. * REPLACING old line(s) by new
  68. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  69. ' $PAGE
  70. '  NAME    -- WildFile
  71. '
  72. '  INPUTS  -- PARAMETER             MEANING
  73. '             Pattern$           PATTERN TO CHECK AGAINST
  74. '             ItemToMatch$       FILE NAME TO MATCH
  75. '
  76. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  77. '
  78. '  PURPOSE  Determine whether a file name is an instance of
  79. '    a file specification.  Exactly like DOS except that ? must have a
  80. '    character.
  81. '
  82.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  83.       IF Pattern$ <> PrevPattern$ THEN _
  84.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  85.          PrevPattern$ = Pattern$
  86.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  87.       DoesMatch = ZFalse
  88.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  89.          EXIT SUB
  90.       CALL WildCard (PPrefix$,IPrefix$)
  91.       IF NOT ZOK THEN _
  92.          EXIT SUB
  93.       CALL WildCard (PExt$,IExt$)
  94.       DoesMatch = ZOK
  95.       END SUB
  96. * ------[ first line different ]------
  97. '
  98. ' Pe 02/03/90---- Removed SendName and Testuser subs
  99. '
  100. '
  101.  
  102. ' ********* Maple UPDTU... ******
  103. '
  104. '
  105. * DELETING old line(s)
  106. 20293
  107. 20295
  108. 20296
  109. 20298
  110. 20300
  111. 20305
  112. 20306
  113. 20310
  114. 20313
  115. 20315
  116. * REPLACING old line(s) by new
  117. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  118. ' $PAGE
  119. * ------[ first line different ]------
  120. '  SUBROUTINE NAME    -- UpdtUpload
  121. '
  122. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  123. '                        ZFileName$
  124. '                        ZUpldDir$
  125. '                        ZFileNameHold$
  126. '                        ZShareIt
  127. '                        ZFMSDirectory$
  128. '                        ZWasQ!
  129. '                        TCA!
  130. '
  131. '  OUTPut PARAMETERS  -- ZBytesInFile#
  132. '                        ZSecsPerSession!
  133. '
  134. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  135. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  136. '
  137.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1),LinesInDesc,WasFF) STATIC '<===
  138.       ON WasFF GOTO 20710,20724,20722   'Pe 11/20/89
  139. * DELETING old line(s)
  140. 20708
  141. 20709
  142. * REPLACING old line(s) by new
  143. * ------[ first line different ]------
  144. 20710 ZAlreadyGiven = ZFalse         'Pe BatchUp Mod
  145.       ZAbort = ZFalse    ' PE ZAbort MOD
  146.       X = 92
  147.       Gosub 20800
  148.       Call QuickTput1 ("Describe " + ZFileNameHold$ )
  149.       Call QuickTput1( OutTxt$)
  150.       X = 93
  151.       Gosub 20800
  152.       Call QuickTput1 ( LEFT$(OutTxt$,ZMaxDescLen - 4) + "Max>")    'JW03-20-92
  153.       ZOutTxt$ = ""
  154.       ZSubParm = 1
  155.       ZParseOff = ZTrue
  156.       CALL TGet
  157.       CALL Carrier
  158.       IF ZSubParm = -1 THEN _                'Pe 11/20/89
  159.          EXIT SUB                            'Pe 11/20/89
  160.       TempUserIn$ = ZUserIn$                 'Pe 02/17/90
  161.       CALL AllCaps (TempUserIn$)             'Pe 02/17/90
  162.       IF TempUserIn$ = "ABORT" THEN _        'Pe 02/17/90
  163.       ZAbort = ZTrue : _
  164.       TempUserIn$ = "" : _                    'Pe 02/17/90
  165.       EXIT SUB
  166.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 7 THEN _
  167.       X = 94 : _
  168.       Gosub 20800 : _
  169.       CALL QuickTput1(OutTxt$ + STR$(ZMaxDescLen) + " chars max") : _
  170.       X = 95 : _
  171.       Gosub 20800 : _
  172.       Call QuickTput1 (OutTxt$) : _
  173.          GOTO 20710
  174. * REPLACING old line(s) by new
  175. * ------[ first line different ]------
  176. 20712 ZDesc$ = ZUserIn$
  177.       IF NOT ZLimitSearchToFMS THEN _
  178.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  179.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  180.              GOTO 20719_
  181.             ELSE GOTO 20716
  182. * REPLACING old line(s) by new
  183. * ------[ first line different ]------
  184. 20715  IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  185.          ZUCat$ = "***" : _
  186.          GOTO 20719
  187. * INSERTING new line(s)
  188. 20716 ZUCat$ = ZDefaultCatCode$
  189.       IF ZSubParm = -1 OR _
  190.       ZUserSecLevel < ZSLCategorizeUplds THEN _
  191.       GOTO 20719
  192.      If ZMplPersUpload = Ztrue Then _                      'Pe 06/08/91
  193.                Goto 20719
  194. * REPLACING old line(s) by new
  195. * ------[ first line different ]------
  196. 20717 TempIndex = ZLastIndex             'Pe 09/14/91
  197.       CALL BufFile (ZUpcatHelp$,WasX)
  198.       ZLastIndex = TempIndex             'Pe 09/14/91
  199. * REPLACING old line(s) by new
  200. * ------[ first line different ]------
  201. 20718 X = 294       'Pe 01/27/93
  202.       Gosub 20800    'Pe 01/27/93
  203.       ZOutTxt$ = OutTxt$
  204.       ZSubParm = 1
  205.       CALL TGet
  206.       CALL AraAllCaps (ZUserIn$(),1)
  207.       IF ZSubParm = -1 THEN _
  208.        EXIT SUB                                   'Pe 11/20/89
  209.       IF ZWasQ = 0 THEN _
  210.          GOTO 20717
  211.       IF ZUserIn$(1) = "H" OR _
  212.          ZUserIn$(1) = "*" OR _
  213.          ZUserIn$(1) = "?" THEN _
  214.          GOTO 20717
  215.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  216.       IF Found > 0 THEN _
  217.          ZUCat$ = ZCategoryCode$(Found) : _
  218.          IF LEN(ZUCat$) > 0 AND LEN(ZUCat$) < 4 AND INSTR(ZUCat$,",") = 0 THEN _
  219.             GOTO 20719
  220.       ZUCat$ = ""
  221.       IF NOT ZLimitSearchToFMS THEN _
  222.          StrewTo$ = ZDirPath$ + _
  223.                      ZUserIn$(1) + _
  224.                      "." + _
  225.                      ZDirExtension$ : _
  226.    CALL FindIt (StrewTo$) : _                  'Pe 11/21/89
  227.     IF ZOK THEN _
  228.             GOTO 20719 _
  229.          ELSE CALL WORDInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  230.               IF ZOK THEN _
  231.                  GOTO 20719
  232.       StrewTo$ = ""
  233.       X = 96
  234.       Gosub 20800
  235.       CALL QuickTPut1 (OutTxt$ + " " + ZUserIn$(1)) 
  236.       GOTO 20717                                      'Pe 11/21/89
  237. * REPLACING old line(s) by new
  238. * ------[ first line different ]------
  239. 20719 IF ZUpBatchTransfer Then _
  240.       CALL BatchUpLoad (ZDesc$,ZUCat$,1) : _
  241.          Goto 20720
  242.           IF ZMplPersUpload = ZTrue THEN _
  243.            ZMplPersUpload = ZFalse : _
  244.           GOTO 20720
  245.         IF ZUserSecLevel >= ZAskExtendedDesc AND _
  246.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  247.       X = 97 : _      'Pe 01/19/93
  248.       Gosub 20800 : _ 'Pe 01/19/93
  249.          ZOutTxt$ = OutTxt$ + " " + ZFileNameHold$ + " (Y,[N])" : _
  250.          ZTurboKey = -ZTurboKeyUser : _
  251.          ZSubParm = 1 : _
  252.          CALL TGet : _
  253.      IF ZSubParm <> -1 THEN _
  254.         IF  ZYes THEN _
  255.        CALL SkipLine (2):_
  256.       X = 98 : _          'Pe 01/19/93
  257.       Gosub 20800 :_       'Pe 01/19/93
  258.       CALL QuickTPut (Chr$(7)+OutTxt$,2) : _
  259.     CALL DelayTime (2) :_
  260.    ZGetExtDesc = ZTrue
  261.   '
  262. * REPLACING old line(s) by new
  263. * ------[ first line different ]------
  264. 20720 CALL OpenOutW ("UPDESC" +ZNodeID$ +".LST")
  265.           Print #2, ZFileName$
  266.           Print #2, ZFileNameHold$
  267.           Print #2, ZDesc$
  268.           Print #2, ZUCat$
  269.           Print #2, ZActiveFMSDir$
  270.           Print #2, ZFMSDirectory$
  271.           Print #2, ZAbort
  272.           Print #2, ZGetExtDesc
  273.           Print #2, StrewTo$
  274.           Print #2, ZAllwaysStrewTo$
  275.           Print #2, ZUpldDir$
  276.           Close 2
  277.   EXIT SUB
  278. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  279. '
  280. * REPLACING old line(s) by new
  281. * ------[ first line different ]------
  282. 20722 GOSUB 20760       'Pe 09/12/91
  283.       GOTO 20732        'Pe 09/12/91
  284. '
  285. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  286. '
  287. * DELETING old line(s)
  288. 20723
  289. * INSERTING new line(s)
  290.  20724 IF ZPrivateDoor THEN
  291.         CALL OpenWork (2,"UPDESC" +ZNodeID$ +".LST")
  292.          While Not EOF(2)
  293.           Input #2, ZFileName$
  294.           Input #2, ZFileNameHold$
  295.           Input #2, ZDesc$
  296.           Input #2, ZUCat$
  297.           Input #2, ZActiveFMSDir$
  298.           Input #2, ZFMSDirectory$
  299.           Input #2, ZAbort
  300.           Input #2, ZGetExtDesc
  301.           Input #2, StrewTo$
  302.           Input #2, ZAllwaysStrewTo$
  303.           InPut #2, ZUpldDir$
  304.          Wend
  305.         Close 2
  306.     END IF
  307.      CALL KillWork ("UPDESC" +ZNodeID$ +".LST")      'Pe 06/10/92
  308.          IF ZErrCode > 0 THEN _                      'Pe 06/10/92
  309.             ZErrCode = 0                             'Pe 06/10/92
  310.   GOSUB 20738        'find uploaded file
  311. '
  312. If Not ZAlreadyGiven THEN
  313.     CALL TimeRemain (MinsRemaining)
  314.       IF ZPrivateDoor THEN _
  315.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  316.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  317. END IF
  318. '
  319. '************************ New Convert code begins here *******************
  320. ' added X2ZIP?.LST.......01/18/90
  321. '
  322. '      Zip Convert code.  Does the following:
  323. '     IF X2ZIP? (?=Node #) is found then any file extension
  324. '     Listed in this file is NOT touched any other file will
  325. '     Be converted to ZIP format. IF the file is NOT found then
  326. '     user is asked to convert file....!! 
  327. '     The First line determins weather to ask user to Convert or not
  328. '     This should either be a Yes or NO (in Upper case only) if Yes
  329. '     then  user has the option of converting the file the rest of the
  330. '     file should have one EXTENSION  per line including the "."
  331. '    ex: .ARC <CR> 
  332. '
  333. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  334. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  335. '         ZOO.BAT
  336. '
  337. '      The Library work path (Config parm # 304) is used for a work area !!!
  338. '
  339.   IF ZAbort = ZTrue THEN _     'Corrects aborted uploads
  340.     EXIT SUB                'corrects aborted uploads
  341.      CALL BreakFileName (ZFileName$, WDR$, WZZ$, WX$, ZTrue)    'Pe 11/26/89
  342. '
  343. ' Pe 09/25/91 to next comment
  344. '
  345. CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  346.   WasX$ = ZDiskForDos$ + "TESTUP.BAT"                     'Pe 12/25/92
  347.    CALL FindIt (WasX$)
  348.      IF ZOK THEN
  349.        IF ZSysop OR ZUserSecLevel >= ZAddDirSecurity THEN ' DD120201
  350.         ZSubParm = 1                                      ' DD120201
  351.          X = 295       'Pe 01/27/93
  352.          Gosub 20800    'Pe 01/27/93
  353.         ZOutTxt$ = OutTxt$ + _           ' DD120201     'Pe 12/05/92
  354.                    ZFileNameHold$ + "([Y],N)"       ' DD120201     'Pe 12/27/92
  355.         ZTurboKey = -ZTurboKeyUser                        ' DD120201
  356.         CALL TGet                                         ' DD120201
  357.         IF ZSubParm = -1 THEN _                           ' DD120201
  358.            EXIT SUB                                       ' DD120201
  359.           IF ZNO THEN _                                   ' DD120201
  360.              NoCmt = ZTrue : _                            ' Pe021393
  361.              GOTO 20727                                   ' DD120201
  362.        END IF                                             ' DD120201
  363. '
  364.       X = 99 : _          'Pe 01/19/93
  365.       Gosub 20800 :_       'Pe 01/19/93
  366.      CALL QuickTPut1 (OutTxt$)
  367.       CALL ReadDir (2,1)
  368.        ZGSRAra$(2) = ZNodeWorkDrvPath$ + "VCHK" + ZNodeFileID$
  369.        IF EOF(2) THEN _
  370.         WasX$ = ZOutTxt$ : _
  371.         ZGSRAra$(1) = ZFileName$ _
  372.         ELSE _
  373.    WasX$ = WasX$ + " " + ZFileName$ + " " + Pre$ + _
  374.            " "+ Body$ + " " + Ext$ + " " + ZNodeId$
  375.    WasX$ = WasX$ +" " +  ZGSRAra$(2) + _  'Pe 12/25/92
  376.                  " " + ZComPort$ + " " + ZFirstName$ : _          'Pe 12/25/92
  377.           IF ZWasBatchTransfer THEN _                             'Pe 12/25/92
  378.            CALL TimeBack (1)                                      'Pe 12/25/92
  379.        CALL ShellExit (WasX$)
  380.        CALL FindIt (ZGSRAra$(2))
  381.        IF ZOK THEN _
  382.          IF LOF(2) > 2 THEN _
  383.             ZBytesInFile# = 0.0 : _
  384.              X = 100 : _          'Pe 01/19/93
  385.               Gosub 20800 :_       'Pe 01/19/93
  386.              WasX$ = OutTxt$ + " " + ZFileNameHold$ : _
  387.               CALL QuickTPut1 (WasX$) : _
  388.              CALL UpdtCalr (WasX$,2) : _
  389.             CALL KillWork (ZFileName$) : _
  390.             CALL KillWork (ZGSRAra$(2)) : _    ' Pe 02/04/92
  391.            ZGetExtDesc = ZFalse : _                               'Pe 12/25/92
  392.            EXIT SUB
  393.       IF ZWasBatchTransfer THEN _                                 'Pe 12/25/92
  394.          CALL TimeBack (2)                                        'Pe 12/25/92
  395.   END IF                                                          'Pe 12/26/92
  396.  
  397. Call FindIt (ZDiskForDos$ + "CNVT2"+ ZDefaultExtension$+ "." + ZNodeId$) 'Pe 12/26/92
  398.         If NOT ZOK THEN _                                         'Pe 12/26/92
  399.           GOTO 20727                                              'Pe 12/26/92
  400. * REPLACING old line(s) by new
  401. * ------[ first line different ]------
  402. 20726 CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  403.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  404.       ZUserIn$(0) = ZFileName$
  405.       ZFileName$ = Pre$ + ZFileNameHold$
  406.       CALL FindIt (ZFileName$)
  407.       WX$ = "." + ZDefaultExtension$               ' Pe 12/27/92
  408.       IF NOT ZOK THEN _
  409.       CALL UpdtCalr (ZFileName$ + " < ERROR in Cnvt >",2) : _
  410.          ZFileName$ = ZGSRAra$(1) : _
  411.          CALL FindIt (ZFileName$) : _
  412.          ZFileNameHold$ = Body$ + Ext$ : _
  413.          WX$ = + Ext$ : _                      ' Pe 12/27/92
  414.          IF ZOK THEN _
  415.            ZFileName$ = ZFileNameHold$
  416. '
  417. ' ***  adds BBS name , users name and description to Zip comment if succesfull
  418. '
  419. * REPLACING old line(s) by new
  420. * ------[ first line different ]------
  421. 20727 GOSUB 20738     'Pe 11/21/89 calls findit if ok add bytes and upload#
  422. '
  423. 'Pe 01/26/92  Changes to add Zip Comments via a BAT file
  424. '             ext$ = Extension of file to add comment  eg ARJCMT.BAT for Arj's
  425. '             ZIPCMT.BAT for Zips
  426. '             format of the ZIPCMT.BAT file is as follows
  427. '             PKZIP -z [1] < [2]
  428. '
  429. '             can also use %1 %2  were %1 = Drive/path/filename
  430. '                                      %2 = Drive/Path/CommentFileName 
  431. '                                      %3 = Commport ( don't ask Why) 
  432. '
  433. '    Here is a BAT file that will add an advertisment + the Comment
  434. '   created by Maple RBBS to the Zip header ( WHY ??)
  435. '
  436. '    @Echo off
  437. '    Copy c:\Upload\MyAd.txt+c:\upload\upload.cmt c:\upload\upload1.cmt
  438. '    copy c:\upload\upload1.cmt c:\upload\upload.cmt
  439. '    del c:\upload\upload1.cmt
  440. '    PKZIP -z %1 < %2
  441. '
  442. * DELETING old line(s)
  443. 20728
  444. * REPLACING old line(s) by new
  445. * ------[ first line different ]------
  446. 20729  If NoCmt = ZTrue Then _                            'Pe021393
  447.           NoCmt = ZFlase : _                               'Pe021393
  448.         goto 20730                                         'Pe021393
  449.      IF ZBytesInFile# > 2.0 THEN                           'Pe021393
  450.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)  'Pe 11/30/92
  451.      WasX$ = ZDiskForDos$+Mid$(Ext$,2,3)+"CMT.BAT"
  452.       CALL FindIt (WasX$)
  453.         IF ZOK THEN
  454.           CLOSE 2
  455.          X = 101           'Pe 01/19/93
  456.           Gosub 20800       'Pe 01/19/93
  457.           CALL QuickTPut (OutTxt$ + " " + ZFileNameHold$ + " ..." ,2)
  458.            CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT
  459.           ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
  460.          ADDCMT2$ = ZCrLf$ +"Description: " + ZDesc$
  461.         ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + ZCrLf$
  462.        CALL OpenOutW (CommentName$)
  463.       PRINT #2, ADDCOMMENT$
  464.      CLOSE 2
  465.  
  466.           ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  467.            CALL OpenWork (2,WasX$)
  468.            CALL ReadDir (2,1)
  469.                 IF EOF(2) THEN _
  470.                    ZWasZ$ = ZOutTxt$ : _
  471.                    ZGSRAra$(1) = ZFileName$ : _
  472.                    ZGSRAra$(2) = CommentName$ _
  473.                 ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  474.                               " " + CommentName$ + " " + ZGSRAra$(3)
  475.             CALL ShellExit (ZWasZ$)
  476.  
  477.          GOSUB 20738          ' Adjust Bytes in file make sure we got it
  478.      END IF
  479.    END IF
  480. * INSERTING new line(s)
  481. 20730  ZOK = 0 
  482.        CALL CheckNovell (ZOK)
  483.          IF ZOK <> -1 THEN _
  484.            CALL SetSharedAttr (ZFileName$, ZOK) : _
  485.           IF ZOK <> 0 THEN _
  486.         CALL PScrn ("Error setting shared attribute")
  487.        IF ZGetExtDesc THEN _
  488.         EXIT SUB 
  489. GOSUB 20760                   'Pe 09/12/91
  490.  
  491. * DELETING old line(s)
  492. 20731
  493. * REPLACING old line(s) by new
  494. * ------[ first line different ]------
  495. 20732 If ZMusic = ZFalse Then                                       'Pe 03/13/92
  496.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" OR NumPersonals > 0 THEN _
  497.       WX$ = WX$+"*"    'Pe 01/25/92
  498.       CALL AMorPM                                                  'Pe 11/25/89
  499.    IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN _  'Pe 11/25/89
  500.            ULBYNAME$ = "Sysop" _                                   'Pe 06/05/91
  501.          ELSE ULBYNAME$ = ZActiveUserName$                         'Pe 11/25/89
  502.       ULXXX$ = WZZ$+WX$+SPACE$(13-(LEN(WZZ$)+LEN(WX$)))            'Pe 01/24/90
  503.       UPLOADLG$ = "{C1"+ ULXXX$ + _                                'Pe 01/24/90
  504.                   "{C2"+ ULBYNAME$+SPACE$(34-LEN(ULBYNAME$)) + _   'Pe 01/24/90
  505.                   "{C3"+ DATE$ + "   " + _                         'Pe 01/24/90
  506.                   "{C4"+ ZTime$+" {C0"                             'Pe 01/24/90
  507.          CALL OpenWorkA (ZDirPath$ +"UPLOADLG.DEF")                'Pe 03/13/92
  508.          CALL PrintWorkA (UPLOADLG$)                               'Pe 11/25/89
  509.          CLOSE 2                                                   'Pe 01/18/90
  510. End IF                                                             'Pe 03/13/92
  511.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _ 
  512.         IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  513.          CALL UpdtCalr (ZUserIn$,2): _
  514.        GOTO 20733
  515. IF NumPersonals <> 0 THEN _ 
  516.          GOTO 20733            
  517.       IF ZPrivateDoor THEN _   
  518.          ZWasEN$ = ZUpldDoor$ _
  519.       ELSE ZWasEN$ = ZUpldDir$ 
  520.       GOSUB 20734 
  521. * INSERTING new line(s)
  522. 20733 ZWasDF$ = " >> uploaded << "
  523.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  524.       ZWasZ$ = WasX$ + _
  525.            Extension$ + _
  526.            ZWasDF$ + _
  527.            " at " + _
  528.            ZTime$ + _
  529.            " using " + _
  530.            ZWasFT$ + _
  531.            STR$(ZBytesInFile#)
  532.       CALL UpdtCalr (ZWasZ$,2)
  533.       Call MenuPlus (6)                               ' MS021393
  534.       ZUplds = ZUplds + 1
  535.       ZGlobalUplds = ZGlobalUplds + 1
  536.       ZULBytes! = ZULBytes! + ZBytesInFile#
  537.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  538. '
  539. IF NOT ZAlreadyGiven THEN
  540.       CALL TimeRemain (MinsRemaining!)
  541.       MinsToAdd = WasX! / 60
  542.       CALL ChkAddedTime (MinsToAdd)
  543.       WasX! = MinsToAdd * 60!
  544.       ZTimeCredits! = ZTimeCredits! + WasX!
  545.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  546.       IF ZPrivateDoor THEN _
  547.          WasX! = (WasX! - ZWasQ!) / 60.0 _
  548.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  549.       WasX$ = STR$(FIX(WasX!*10.0))
  550.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  551.         IF WasX! > 1.0 THEN _
  552.       X = 102 : _          'Pe 01/19/93
  553.       Gosub 20800 :_       'Pe 01/19/93
  554.        CALL QuickTPut1 (WasX$+" "+ OutTxt$)
  555. END IF
  556.       X = 103           'Pe 01/19/93
  557.       Gosub 20800       'Pe 01/19/93
  558.       CALL QuickTPut (OutTxt$ + " " + ZFirstName$ ,1)
  559.      CALL DelayTime (2)       'Pe 02/23/90
  560.     ZGetExtDesc = ZFalse
  561.   EXIT SUB
  562. * REPLACING old line(s) by new
  563. * ------[ first line different ]------
  564. 20734 '          ---[ lock file ]---
  565.       IF ZWasEN$ = "" THEN _
  566.          RETURN
  567.       IF NOT ZPrivateDoor THEN                                       ' DD120501
  568.          tempfile$ = ZNodeWorkDrvPath$ + "FILE_ID.DIZ"               ' DD120501
  569.          CALL FindItX (tempfile$,7)                                  ' DD120501
  570.      FileIDFound = ZFalse              ' Pe 02/04/92
  571.          IF ZOK THEN                                                 ' DD120501
  572.              FileIDFound = ZTrue       ' Pe 02/04/92
  573.             ZGetExtDesc = ZTrue                                      ' DD120501
  574. '         IF LEFT$(ZDesc$,1) <> "/" AND LEFT$(ZDesc$,1) <> "\" THEN _' DD120501
  575. '              ZDesc$ = "Description within Distribution Package:"   ' DD120501
  576.             WasLL = ZRightMargin                                     ' DD120501
  577.             ZRightMargin = 30 + ZMaxDescLen                          ' DD120501
  578.             IF ZRightMargin > 74 THEN _                              ' DD120501
  579.                ZRightMargin = 74                                     ' DD120501
  580.             LinesInDesc = 0                                          ' DD120501
  581.             WHILE NOT EOF(7) AND LinesInDesc < ZMaxExtendedLines     ' DD120501
  582.                LinesInDesc = LinesInDesc + 1                         ' DD120501
  583.                LINE INPUT #7,ZOutTxt$(LinesInDesc)                   ' DD120501
  584.                CALL RemNonAlf (ZOutTxt$(LinesInDesc),31,127)         ' DD021201
  585.                IF LEN(ZOutTxt$(LinesInDesc - 1)) < (ZRightMargin - 10) AND _' DD120501
  586.                   LinesInDesc > 1 THEN _                             ' DD120501
  587.                   ZOutTxt$(LinesInDesc - 1) = ZOutTxt$(LinesInDesc - 1) + _' DD120501
  588.                      " " + ZOutTxt$(LinesInDesc) : _                 ' DD120501
  589.                   ZOutTxt$(LinesInDesc) = "" : _                     ' DD120501
  590.                   ZOutTxt$(LinesInDesc + 1) = "" : _                 ' DD120501
  591.                   LinesInDesc = LinesInDesc - 1                      ' DD120501
  592.             WEND                                                     ' DD120501
  593.             CLOSE 7                                                  ' DD120501
  594.             CALL WordWrap (ZRightMargin,LinesInDesc,ZOutTxt$())      ' DD120501
  595.             X = 104          'Pe 01/19/93
  596.             Gosub 20800      'Pe 01/19/93
  597.           CALL QuickTPut1 (CHR$(7) + ZEmphasizeOn$ + OutTxt$ + _     ' DD120501
  598.                 ZEmphasizeOff$)                                      ' DD120501
  599.             CALL KillWork (tempfile$)                                ' DD120501
  600.             ZRightMargin = WasLL                                     ' DD120501
  601.          END IF                                                      ' DD120501
  602.       tempfile$ = ZNodeWorkDrvPath$ + "DESC.SDI"                  ' DD120801
  603.   IF FileIDFound <> ZTrue Then                       ' Pe 02/04/93
  604.          CALL FindItX (tempfile$,7)                                  ' DD120801
  605.          IF ZOK THEN                                                 ' DD120801
  606.             LINE INPUT #7,ZDesc$                                     ' DD120801
  607.             CALL RemNonAlf (ZDesc$,31,127)                           ' DD021201
  608.             IF LEN(ZDesc$) > ZMaxDescLen THEN                        ' DD120801
  609.                LeftDesc$ = LEFT$(ZDesc$,ZMaxDescLen)                 ' DD120801
  610.                RightDesc$ = RIGHT$(ZDesc$,LEN(ZDesc$)-ZMaxDescLen)   ' DD120801
  611.             END IF                                                   ' DD120801
  612.             CLOSE 7                                                  ' DD120801
  613.             ZDesc$ = LeftDesc$                                       ' DD120801
  614.          END IF                                                      ' DD120801
  615.       END IF                                                         ' DD120501
  616. End IF                                               ' Pe 02/04/92
  617.    CALL KillWork (tempfile$)                         ' Pe 02/05/92
  618.     FileIdFound = ZFalse                                 ' Pe 02/05/92
  619.       FMSFormat = ZFalse
  620.       IF (ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS _
  621.           OR NumPersonals > 0 OR (ZPrivateDoor AND ZFMSDoor)) THEN _
  622.              FMSFormat = ZTrue _
  623.       ELSE CALL FindIt (ZWasEN$) : _
  624.            IF ZOK THEN _
  625.               CALL ReadDir (2,1) : _       'Pe 11/22/89
  626.               IF ZErrCode = 0 THEN _
  627.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  628.       IF NOT FMSFormat THEN _
  629.          ReadBackwards = ZFalse : _
  630.          FixedLen = 0 : _
  631.          ZUserIn$ = ZDesc$ : _
  632.          GOTO 20735                                  'Pe 06/08/91
  633.       FixedLen = 34 + ZMaxDescLen 
  634.       IF NumPersonals > 0 THEN _
  635.          WasX$ = "*" : _                                             ' Pe060891
  636.          MaxLen = ZPersonalLen _
  637.       ELSE MaxLen = 3 : _
  638.            WasX$ = ""                                                ' Pe060891
  639.       ZUCat$ = LEFT$(ZUCat$,MaxLen)
  640.       ZUCat$ = ZUCat$ + SPACE$(MaxLen - LEN(ZUCat$))
  641.       ZUserIn$ = ZDesc$ + _
  642.                  SPACE$(ZMaxDescLen - LEN(ZDesc$)) + _
  643.                  ZUCat$ + WasX$                                       ' Pe060891
  644.            ReadBackwards = ZTrue : _
  645.            CALL FindIt (ZWasEN$) : _
  646.            IF ZOK THEN _
  647.               CALL ReadDir (2,1) : _
  648.               IF ZErrCode = 0 THEN _
  649.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  650. * INSERTING new line(s)
  651. 20735 CALL LockAppend      
  652.       IF ZErrCode <> 0 THEN _
  653.          GOTO  20736
  654.  
  655. IF ZVoiceType <> 0 THEN                                        ' Pe 05/29/92
  656.       IF ReadBackwards and NumPersonals = 0 THEN _                  'PE 10/27/91
  657.      PRINT #2, using LEFT$("\                             " _  'BH042091
  658.                              + "                              " _  'BH042091
  659.                              + "                    ", _           'BH042091
  660.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  661.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  662.      '          ---[ append ]---
  663.       IF ZGetExtDesc THEN _
  664.          IF ReadBackwards THEN _
  665.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  666.                GOSUB 20737 : _
  667.             NEXT
  668.       PRINT #2,USING "\           \########  &  &"; _
  669.                      ZFileNameHold$; _
  670.                      ZBytesInFile#; _
  671.                      ZWasZ$; _
  672.                      ZUserIn$
  673.       IF ZGetExtDesc THEN _
  674.          IF NOT ReadBackwards THEN _
  675.             FOR WasI = 1 TO LinesInDesc : _
  676.                GOSUB 20737 : _
  677.             NEXT
  678.       IF NOT ReadBackwards and NumPersonals = 0 THEN _              ,Pe 10/27/91
  679.      PRINT #2, using LEFT$("\                             " _  'BH042091
  680.                              + "                              " _  'BH042091
  681.                              + "                    ", _           'BH042091
  682.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  683.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  684.        GOTO 20736
  685.    End IF                                                  'Pe 05/29/92
  686.  
  687.       IF ZGetExtDesc THEN _
  688.          IF ReadBackwards THEN _
  689.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  690.                GOSUB 20737 : _
  691.             NEXT
  692.       PRINT #2,USING "\           \########  &  &"; _
  693.                      ZFileNameHold$; _
  694.                      ZBytesInFile#; _
  695.                      ZWasZ$; _
  696.                      ZUserIn$
  697.       IF ZGetExtDesc THEN _
  698.          IF NOT ReadBackwards THEN _
  699.             FOR WasI = 1 TO LinesInDesc : _
  700.                GOSUB 20737 : _
  701.             NEXT
  702. * REPLACING old line(s) by new
  703. * ------[ first line different ]------
  704. 20736 CALL UnLockAppend      'Pe 06/08/91
  705.       FixedLen = 0
  706.       RETURN
  707. * INSERTING new line(s)
  708. 20737 WasX$ = ZOutTxt$(WasI)   'Pe 06/08/91
  709.       CALL Trim (WasX$)
  710.       IF WasX$ = "" THEN _
  711.          RETURN
  712.       IF NOT FMSFormat THEN _
  713.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  714.          RETURN
  715.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  716.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  717.       ELSE WasX$ = ""
  718.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  719.       RETURN
  720. 20738 CALL FindIt (ZFileName$)
  721. 20739 IF NOT ZOK THEN _                         'Pe 06/08/91
  722.          ZBytesInFile# = 0.0_
  723.       ELSE ZBytesInFile# = LOF(2)
  724.       IF ZBytesInFile# < 2.0 THEN _
  725.        ZAutoLogOffReq = ZFalse : _           'Pe 10/20/91     
  726.          EXIT SUB
  727.       RETURN
  728. '20747 CALL CheckInt (ZUCat$)                                          ' KG082201
  729. '      IF ZTestedIntValue > 0 THEN _                                  ' KG082201
  730. '        ZUCat$ = " " + ZUCat$                                         ' KG082201
  731. '      RETURN                                                         ' KG082201
  732. * DELETING old line(s)
  733. 20741
  734. 20742
  735. * INSERTING new line(s)
  736. 20760 CALL FindItX (ZNodeWorkFile$,7)
  737.       ZUserIn$ = ZDesc$
  738.       WasX$ = DATE$
  739.       ZWasZ$ = LEFT$(WasX$,6) + _
  740.            RIGHT$(WasX$,2)
  741.       ZWasEN$ = ZPersonalDir$
  742.       NumPersonals = 0
  743.       IF NOT ZOK THEN _                                            'Pe 06/10/92
  744.          GOTO 20781                                                'Pe 06/10/92
  745.       UserFileIndexSave = ZUserFileIndex
  746.       UserRecordHold$ = ZUserRecord$
  747.       WHILE NOT EOF(7)
  748.          CALL ReadParmsX (7,ZWorkAra$(),2,1)
  749. IF LEFT$(ZWorkAra$(1),4) <> "ALL " AND _
  750.            ZWorkAra$(1) <> "ALL" AND VAL (ZWorkAra$(2)) > 0 THEN _ 'Pe 06/10/92
  751.             NumPersonals = NumPersonals + 1 : _
  752.             ZUCat$ = ZWorkAra$(1) : _ ' GOSUB 20747  'Pe 01/31/93 don't work
  753.             GOSUB 20734 : _ 
  754.             RcvrRecNum = VAL (ZWorkAra$(2)) : _
  755.             CALL SetUserFlag (RcvrRecNum,4096,"file")
  756.       WEND
  757.       CLOSE 7
  758.       IF NumPersonals > 0 THEN _
  759.          ZUserFileIndex = UserFileIndexSave : _
  760.          LSET ZUserRecord$ = UserRecordHold$
  761. 20781 ZUserIn$ = ZDesc$
  762.       WasX$ = DATE$
  763.       ZWasZ$ = LEFT$(WasX$,6) + _
  764.                RIGHT$(WasX$,2)
  765.       ZWasEN$ = StrewTo$
  766.       GOSUB 20734
  767.       ZWasEN$ = ZAllwaysStrewTo$
  768.       GOSUB 20734
  769.       RETURN
  770. 20800 Call GetRBBSString(X,RBBSString$)      'Pe 01/16/93
  771.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  772.       Return
  773.       END SUB
  774. 20841 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'  'Pe 09/12/91
  775. ' $PAGE
  776. '
  777. '  NAME    -- BadFile
  778. '
  779. '  INPUTS  --     PARAMETER                    MEANING
  780. '               ZViolation$
  781. '               ZViolationsThisSession
  782. '               FilName$                      NAME OF FILE
  783. '
  784. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  785. '                                         2 = CHARACTER NOT ALLOWED
  786. '                                         3 = SYSTEM CRASH ATTEMPT
  787. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  788. '             FilName$                    Gets capitalized
  789. '
  790. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  791. '             to either crash the system or to breach RBBS-PC's security.
  792. '
  793.       SUB BadFile (FilName$,Result) STATIC
  794. '
  795. '
  796. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  797. '
  798. '
  799.       Result = 2
  800.       IF LEN(FilName$) < 1 THEN _
  801.          EXIT SUB
  802.       CALL BadFileChar (FilName$,ZOK)
  803.       IF NOT ZOK THEN _
  804.          EXIT SUB
  805.       CALL AllCaps (FilName$)
  806.       WasXX = INSTR(FilName$,".")
  807.       IF WasXX > 0 THEN _
  808.          IF WasXX < LEN(FilName$) THEN _
  809.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  810.             IF WasXX > 0 THEN _
  811.                EXIT SUB
  812.       WasXX = LEN(FilName$)
  813.       IF WasXX => 3 THEN _
  814.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  815.             GOTO 20842
  816.       IF WasXX => 5 THEN _      'Pe02493  was 4
  817.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
  818.             GOTO 20842
  819.       IF WasXX => 6 Then _                                     'Pe022093
  820.         If INSTR("CLOCK$:",FilName$) THEN _                    'Pe022093
  821.          GOTO 20842                                            'Pe022093
  822.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  823.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  824.          EXIT SUB
  825.       WasXX = LEN(Body$)
  826.       IF WasXX => 3 THEN _
  827.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  828.             GOTO 20842
  829.       IF WasXX => 5 THEN _         'Pe02493  was 4
  830.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
  831.             GOTO 20842
  832.       IF WasXX => 6 THEN _                                         'Pe022093
  833.          If INSTR("CLOCK$:",Body$) THEN _                          'Pe022093
  834.            GOTO 20842                                              'Pe022093
  835.       Result = 1
  836.       EXIT SUB
  837. 20842 ZViolationsThisSession = ZMaxViolations   'Pe 09/12/91
  838.       ZViolation$ = ZViolation$ + _
  839.                    FilName$
  840.       Result = 3
  841.       END SUB
  842. '
  843. * DELETING old line(s)
  844. 21105
  845. 21110
  846. 21115
  847. 21117
  848. 21120
  849. 21121
  850. 21122
  851. 21126
  852. 21130
  853. 21140
  854. 21145
  855. 21150
  856. 21151
  857. 21152
  858. 21153
  859. 21155
  860. 21156
  861. 21157
  862. 21158
  863. 21159
  864. * REPLACING old line(s) by new
  865. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  866. ' $PAGE
  867. '
  868. '  NAME    -- FileLock
  869. '
  870. '  INPUTS  --     PARAMETER                    MEANING
  871. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  872. '                                      2 FLUSH MESSAGE RECORD TO DISK
  873. '                                        AND UNLOCK MESSAGES
  874. '                                      3 LOCK MESSAGE FILE
  875. '                                      4 UNLOCK MESSAGE FILE
  876. '                                      5 LOCK USER FILE
  877. '                                      6 LOCK 4 RECORD BLOCK IN USER
  878. '                                        FILE
  879. '                                      7 UNLOCK USER FILE
  880. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  881. '                                        FILE
  882. '                                      9 LOCK UPLOAD DIRECTORY OR
  883. '                                        COMMENTS FILE
  884. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  885. '                                        COMMENTS FILE
  886. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  887. '               ZActiveUserFile$         NAME OF USER FILE
  888. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  889. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  890. '                                        FILE NAME TO LOCK/UNLOCK
  891. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  892. '
  893. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  894. '             ZBlk
  895. '             ZLockDrive
  896. '             ZLockFileName$
  897. '             ZLockStatus$
  898. '             ZMsgFileLock
  899. '             ZUserBlockLock
  900. '             ZUserFileLock
  901. '             ZUserFileIndex
  902. '
  903. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  904. '             multiple copies of RBBS-PC are sharing the same
  905. '             files in either a multi-tasking DOS environment or
  906. '             in a local area network environment
  907. '
  908.       SUB FileLock STATIC
  909. * ------[ first line different ]------
  910. If ZNetworkType = 0 THEN _                          'Pe 06/26/92
  911.     Exit Sub                                        'Pe 06/26/92
  912.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  913.                                     26500,27000,27500,29000,29500
  914.       EXIT SUB
  915. '
  916. '
  917. ' *  UNLOCK USERS AND MESSAGES
  918. '
  919. '
  920. * REPLACING old line(s) by new
  921. 22000 IF ZMsgFileLock = ZTrue THEN _
  922.          RETURN
  923.       ZMsgFileLock = ZTrue
  924.       MID$(ZLockStatus$,1,2) = "LM"
  925.       ZSubParm = 2
  926.       CALL Line25
  927.       ZLockFileName$ = ZActiveMessageFile$
  928.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  929.       RETURN
  930. '
  931. '
  932. * ------[ first line different ]------
  933. ' *  LOCK MESSAGE FILE (MULTI-LINK) removed in Maple code
  934. '
  935. '
  936. * REPLACING old line(s) by new
  937. * ------[ first line different ]------
  938. 22100   RETURN
  939. '
  940. '
  941. ' *  LOCK MESSAGE FILE (OMNINET)
  942. '
  943. '
  944. * REPLACING old line(s) by new
  945. 25000 IF NOT ZMsgFileLock THEN _
  946.          RETURN
  947.       ZMsgFileLock = ZFalse
  948.       MID$(ZLockStatus$,1,2) = "UM"
  949.       ZSubParm = 2
  950.       CALL Line25
  951.       ZLockFileName$ = ZActiveMessageFile$
  952.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  953.       RETURN
  954. '
  955. '
  956. * ------[ first line different ]------
  957. ' *  UNLOCK MESSAGE FILE (MULTI-LINK) removed in maple code
  958. '
  959. '
  960. * REPLACING old line(s) by new
  961. * ------[ first line different ]------
  962. 25100  RETURN
  963. '
  964. '
  965. ' *  UNLOCK MESSAGE FILE (OMNINET)
  966. '
  967. '
  968. * REPLACING old line(s) by new
  969. 26000 IF ZUserFileLock = ZTrue THEN _
  970.          RETURN
  971.       ZUserFileLock = ZTrue
  972.       MID$(ZLockStatus$,4,2) = "LU"
  973.       ZSubParm = 2
  974.       CALL Line25
  975.       ZLockFileName$ = ZActiveUserFile$
  976.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  977.       RETURN
  978. '
  979. '
  980. * ------[ first line different ]------
  981. ' *  LOCK USER FILE (MULTI-LINK) removed in maple code
  982. '
  983. '
  984. * REPLACING old line(s) by new
  985. * ------[ first line different ]------
  986. 26100  RETURN
  987. '
  988. '
  989. ' *  LOCK USER FILE (OMNINET)
  990. '
  991. '
  992. * REPLACING old line(s) by new
  993. 26500 IF ZUserBlockLock = ZTrue THEN _
  994.          RETURN
  995.       ZUserBlockLock = ZTrue
  996.       ZBlk = (ZUserFileIndex / 4) + .26
  997.       MID$(ZLockStatus$,7,2) = "LB"
  998.       ZSubParm = 2
  999.       CALL Line25
  1000.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  1001.       RETURN
  1002. '
  1003. '
  1004. * ------[ first line different ]------
  1005. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)  removed in maple code
  1006. '
  1007. '
  1008. * REPLACING old line(s) by new
  1009. * ------[ first line different ]------
  1010. 26600  RETURN
  1011. '
  1012. '
  1013. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1014. '
  1015. '
  1016. * REPLACING old line(s) by new
  1017. 27000 IF NOT ZUserFileLock THEN _
  1018.          RETURN
  1019.       ZUserFileLock = ZFalse
  1020.       MID$(ZLockStatus$,4,2) = "UU"
  1021.       ZSubParm = 2
  1022.       CALL Line25
  1023.       ZLockFileName$ = ZActiveUserFile$
  1024.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1025.       RETURN
  1026. '
  1027. '
  1028. * ------[ first line different ]------
  1029. ' *  UNLOCK USER FILE (MULTI-LINK) removed in maple code
  1030. '
  1031. '
  1032. * REPLACING old line(s) by new
  1033. * ------[ first line different ]------
  1034. 27100  RETURN
  1035. '
  1036. '
  1037. ' *  UNLOCK USER FILE (OMNINET)
  1038. '
  1039. '
  1040. * REPLACING old line(s) by new
  1041. 27500 IF NOT ZUserBlockLock THEN _
  1042.          RETURN
  1043.       ZUserBlockLock = ZFalse
  1044.       ZBlk = (ZUserFileIndex / 4) + .26
  1045.       MID$(ZLockStatus$,7,2) = "UB"
  1046.       ZSubParm = 2
  1047.       CALL Line25
  1048.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1049.       RETURN
  1050. '
  1051. '
  1052. * ------[ first line different ]------
  1053. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) removed in maple code
  1054. '
  1055. '
  1056. * REPLACING old line(s) by new
  1057. * ------[ first line different ]------
  1058. 27600  RETURN
  1059. '
  1060. '
  1061. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1062. '
  1063. '
  1064. * REPLACING old line(s) by new
  1065. 29010 RETURN
  1066. '
  1067. '
  1068. * ------[ first line different ]------
  1069. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS (MULTI-LINK) removed in mpl code
  1070. '
  1071. '
  1072. * REPLACING old line(s) by new
  1073. * ------[ first line different ]------
  1074. 29100 RETURN
  1075. '
  1076. '
  1077. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1078. '
  1079. '
  1080. * REPLACING old line(s) by new
  1081. 29510 RETURN
  1082. '
  1083. '
  1084. * ------[ first line different ]------
  1085. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS  (MULTI-LINK) remove in maple code
  1086. '
  1087. '
  1088. * REPLACING old line(s) by new
  1089. * ------[ first line different ]------
  1090. 29600  EXIT SUB
  1091. '
  1092. '
  1093. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1094. '
  1095. '
  1096. * REPLACING old line(s) by new
  1097. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1098. ' $PAGE
  1099. '
  1100. '  NAME    -- OpenMsg
  1101. '
  1102. '  INPUTS  --     PARAMETER                    MEANING
  1103. '              ZActiveMessageFile$
  1104. '              ZShareIt
  1105. '
  1106. '  OUTPUTS --  ZMsgRec$
  1107. '
  1108.       SUB OpenMsg STATIC
  1109. '
  1110. '
  1111. ' *  OPEN AND DEFINE MESSAGE FILE
  1112. '
  1113. '
  1114. * ------[ first line different ]------
  1115.      CLOSE 1
  1116.       IF ZShareIt THEN _
  1117.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1118.       ELSE OPEN "R",1,ZActiveMessageFile$
  1119.       FIELD 1,128 AS ZMsgRec$
  1120.       END SUB
  1121. * REPLACING old line(s) by new
  1122. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1123. ' $PAGE
  1124. '
  1125. '  NAME    -- FindFKey
  1126. '
  1127. '  INPUTS  --  PARAMETER                 MEANING
  1128. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1129. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1130. * ------[ first line different ]------
  1131. '             ZFullScreenEditor         USER'S PREFERENCE FOR ANSIed
  1132. '             ZCallersFile$             NAME OF CALLERS FILE
  1133. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1134. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1135. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1136. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1137. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1138. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1139. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1140. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1141. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1142. '             ZFirstName$               LOGGED ON USER'S First NAME
  1143. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1144. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1145. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1146. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1147. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1148. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1149. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1150. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1151. '             ZNodeID$                  NODE IDENTIFIER
  1152. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1153. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1154. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1155. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1156. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1157. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1158. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1159. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1160. '                                       -9  = GOT TO DOS
  1161. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1162. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1163. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1164. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1165. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1166. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1167. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1168. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1169. '
  1170. '  OUTPUTS --
  1171. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1172. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1173. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1174. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1175. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1176. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1177. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1178. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1179. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1180. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1181. '             ZSubParm                  -1 Carrier LOST
  1182. '                                       -2 CHAT MODE ACTIVATED
  1183. '                                       -3 FORCE CALLER ON-LINE
  1184. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1185. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1186. '                                       -6 TELL USER ACCESS IS DENIED
  1187. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1188. '                                       -8 Force caller OFFLINE     'Pe 01/31/93
  1189. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1190. '
  1191. '  PURPOSE -- To determine if a function has been pressed on
  1192. '             the PC'S keyboard that is running RBBS-PC.
  1193. '
  1194.       SUB FindFKey STATIC
  1195.       LookUp = ZSubParm
  1196.       IF ZSubParm < -1 THEN _
  1197.          ZSubParm = 0 : _
  1198.          IF LookUp = - 8 THEN _
  1199.             GOTO 33070 _
  1200.          ELSE IF LookUp = - 9 THEN _
  1201.                  GOTO 31000 _
  1202.               ELSE IF LookUp = - 10 THEN _
  1203.                       GOTO 33090
  1204. '
  1205. '
  1206. ' *  TEST FOR FUNCTION KEY PRESSED
  1207. '
  1208. '
  1209. * REPLACING old line(s) by new
  1210. 31398 IF NOT ZLocalUser THEN _
  1211.          CALL Carrier : _
  1212.          IF ZSubParm = -1 THEN _
  1213.             GOTO 33970
  1214. * ------[ first line different ]------
  1215.        GOTO 31399                                'Pe 01/31/93
  1216. '      IF INSTR("MUF",ZActiveMenu$) > 0 THEN 
  1217.       IF INSTR("|@",ZActiveMenu$) = 0 THEN _      'Pe\05\30\91
  1218.          GOTO 31399
  1219.       ZCursorLine = CSRLIN
  1220.       ZCursorRow = POS(0)
  1221.       LOCATE 25,1
  1222.       WasD$ = SPACE$(79)
  1223.       GOSUB 33210
  1224.       LOCATE 25,1
  1225.       Call GetRBBSString(296,RBBSString$)      'Pe 01/16/93
  1226.       WasD$ = RBBSString$                 'Pe 01/16/93
  1227.       GOSUB 33210
  1228.       CALL DelayTime (1)
  1229.       LOCATE ZCursorLine,ZCursorRow
  1230.       ZSubParm = 1
  1231.       CALL Line25
  1232.       GOTO 33970
  1233. * REPLACING old line(s) by new
  1234. 31399 IF ZFunctionKey = 22 THEN _
  1235.          CALL SkipLine (2) : _
  1236. * ------[ first line different ]------
  1237.          Call GetRBBSString(105,RBBSString$): _      'Pe 01/16/93
  1238.          OutTxt$ = RBBSString$: _                 'Pe 01/16/93
  1239.          CALL QuickTPut1 ( ZFirstName$ +OutTxt$) : _
  1240.          CALL DelayTime (8 + ZBPS) : _
  1241.          ZSubParm = -8 : _   'Pe 01/30/93 was a -6
  1242.          GOTO 33970
  1243.       Call GetRBBSString(106,RBBSString$)      'Pe 01/16/93
  1244.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1245.       CALL QuickTPut1 (ZFirstName$ + OutTxt$)
  1246.       CALL DelayTime (8 + ZBPS)
  1247.       IF ZUserFileIndex < 1 THEN _
  1248.          ZSubParm = -6 : _                'Pe 07/11/91
  1249.          GOTO 33970
  1250.       ZUserSecLevel = ZMinLogonSec - 1
  1251.       CALL DenyAccess
  1252.       ZSubParm = -7                       'Pe 07/11/91
  1253.       GOTO 33970
  1254. '
  1255. '
  1256. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1257. '
  1258. '
  1259.  
  1260. * REPLACING old line(s) by new
  1261. 32000 IF NOT ZLocalUser THEN _
  1262.          CALL SkipLine (1) : _
  1263. * ------[ first line different ]------
  1264.     Call GetRBBSString(107,RBBSString$) : _      'Pe 01/16/93
  1265.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1266.          CALL QuickTPut1 (OutTxt$) : _
  1267.          ZFunctionKey = 0 : _
  1268.          CALL DelayTime (3)
  1269.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1270.       'SHELL ZDiskForDos$ + _
  1271.       '      "COMMAND"
  1272.       CLS
  1273.       IF NOT ZLocalUser THEN _
  1274.          CALL Carrier : _
  1275.          IF ZSubParm = -1 THEN _
  1276.             GOTO 33970
  1277.       ZSubParm = 2
  1278.       CALL Line25
  1279.     Call GetRBBSString(108,RBBSString$)       'Pe 01/16/93
  1280.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1281.       CALL QuickTPut1 (OutTxt$)
  1282.       ZCommPortStack$ = ZCarriageReturn$
  1283.       ZWasCM = 0                                                     ' DD062901/ANSICHAT
  1284.       GOTO 33970
  1285. '
  1286. '
  1287. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1288. '
  1289. '
  1290. * REPLACING old line(s) by new
  1291. * ------[ first line different ]------
  1292. 33150 IF ZWasCM = ZTrue THEN _                                       ' DD070401/ANSICHAT
  1293.          GOTO 33970                                                  ' DD070401/ANSICHAT
  1294.       GOTO 33160
  1295. * REPLACING old line(s) by new
  1296. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1297.       ZPageStatus$ = ""
  1298. * ------[ first line different ]------
  1299.       ZSysopGreeting$ = "Hi " + ZFirstName$ + ", this is " + _       ' DD062801/ANSICHAT
  1300.                         ZSysopFirstName$ + " " + ZSysopLastName$ + _ ' DD062801/ANSICHAT
  1301.                         ".  Sorry to break in and CHAT but..."       ' DD062801/ANSICHAT
  1302.  
  1303.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1304.       CALL TimeBack (1)
  1305.  
  1306.       IF ZCanANSIChat = ZTrue THEN                                   ' DD071301/ANSICHAT
  1307.          CALL ANSIChat                                               ' DD062801/ANSICHAT
  1308.       ELSE
  1309.          CALL SkipLine (1)
  1310.          CALL QuickTPut1 (ZSysopGreeting$)
  1311.          CALL SysopChat
  1312.       END IF
  1313. 'Sysop chat allows overstay of Scheduled Events- no way to control giveback
  1314.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1315.       CALL TimeBack (2)
  1316.       ZCommPortStack$ = CHR$(13)
  1317.       GOTO 33155
  1318. '
  1319. '
  1320. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1321. '
  1322. '
  1323. * REPLACING old line(s) by new
  1324. 33190 ZAdjustedSecurity = ZTrue
  1325.       ZUserSecSave = ZUserSecLevel
  1326.       IF (NOT ZConfMode) AND (NOT ZSubBoard) THEN _
  1327.          ZOrigSec = ZUserSecLevel
  1328.       ZSubParm = 2
  1329.       CALL Line25
  1330.       CALL SetPrompt
  1331.       GOTO 33970
  1332. '
  1333. * ------[ first line different ]------
  1334. '
  1335. ' * PGUP DISPLAY USER PROFILE
  1336. '
  1337. '
  1338. * REPLACING old line(s) by new
  1339. 33200 IF NOT ZLocalUser THEN _
  1340.          CALL Carrier : _
  1341.          IF ZSubParm = -1 THEN _
  1342.             GOTO 33970
  1343. * ------[ first line different ]------
  1344.       CALL PageUp
  1345.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1346.       GOSUB 33210
  1347.       WasD$ = "GRAPHICS: " + _
  1348.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1349.       GOSUB 33210
  1350.       WasD$ = "Protocol : " + _
  1351.            ZUserXferDefault$
  1352.       GOSUB 33210
  1353.       WasD$ = "UPPER CASE " + _
  1354.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1355.       GOSUB 33210
  1356.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1357.       GOSUB 33210
  1358.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1359.       GOSUB 33210
  1360.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1361.       GOSUB 33210
  1362.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1363.            " old BULLETINS on logon."
  1364.       GOSUB 33210
  1365.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1366.            " new files on logon."
  1367.       GOSUB 33210
  1368.       WasD$ = "AnsiEditor " + FNOffOn$(ZFullScreenEditor)
  1369.       GOSUB 33210
  1370.       ZTalkAll = ZFalse
  1371.       GOTO 33970
  1372. * REPLACING old line(s) by new
  1373. 33220 IF NOT ZLocalUser THEN _
  1374.          CALL Carrier : _
  1375.          IF ZSubParm = -1 THEN _
  1376.             GOTO 33970
  1377.       CLS
  1378. * ------[ first line different ]------
  1379.       ZWasCM = 0                                                     ' DD070401/ANSICHAT
  1380.       GOTO 33155
  1381. '
  1382. '
  1383. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1384. '
  1385. '
  1386. * REPLACING old line(s) by new
  1387. 33960 IF ZConfMode = ZTrue THEN _
  1388.          IF ZLocalUser THEN _
  1389.             GOTO 33970 _
  1390. * ------[ first line different ]------
  1391.          ELSE Call GetRBBSString(297,RBBSString$): _      'Pe 01/16/93
  1392.          WasD$ = RBBSString$: _                 'Pe 01/16/93
  1393.               GOSUB 33210 : _
  1394.               GOTO 33970
  1395.       ZSubParm = 3
  1396.       CALL FileLock
  1397.       IF ZSubParm = -1 THEN _
  1398.          GOTO 33970
  1399.       CALL OpenMsg
  1400.       FIELD 1,128 AS ZMsgRec$
  1401.       GET 1,ZNodeRecIndex
  1402.       MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
  1403.       CALL SaveProf (2)
  1404.       FIELD 1, 128 AS ZMsgRec$
  1405. * REPLACING old line(s) by new
  1406. * ------[ first line different ]------
  1407. 33970 IF ZFunctionKey < 22 AND ZFunctionKey > 15 THEN _           'DGS-L25MOD
  1408.          MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 : _ 'DGS-L25
  1409.          CALL Line25                                              'DGS-L25
  1410.       END SUB                                                     'DGS-L25MOD
  1411. * REPLACING old line(s) by new
  1412. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  1413. ' $PAGE
  1414. '
  1415. '  NAME    -- PageUp
  1416. '
  1417. '  INPUTS  --     PARAMETER                    MEANING
  1418. '                 ZActiveUserName$       CURRENT USER NAME
  1419. '                 ZDnlds                 # OF FILES DOWNLOADED
  1420. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  1421. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  1422. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  1423. '                 ZPswdSave$             USERS PASSWORD
  1424. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  1425. '                 ZUplds                 # OF FILES UPLOADED
  1426. '                 ZUserSecSave           USERS SECURITY LEVEL
  1427. '
  1428. '  OUTPUTS -- ZMsgRec$
  1429. '
  1430.       SUB PageUp STATIC
  1431.       CALL LPrnt (" ",1)
  1432.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  1433.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  1434. * ------[ first line different ]------
  1435.       CALL LPrnt ("PASSWORD  : " + ZPswdSave$,1)
  1436.       CALL LPrnt ("BAUD RATE : "+  ZCBaud$ + " Bps",1)       'Pe 06/01/92
  1437.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  1438.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  1439.       CALL LPrnt ("LAST ON   : " + ZLastDateTimeOnSave$,1)
  1440.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  1441.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  1442.       IF ZEnforceRatios THEN _
  1443.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  1444.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  1445.       IF ZRestrictByDate THEN _
  1446.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  1447.       CALL LPrnt ("User's Profile",1)
  1448.       END SUB
  1449. * INSERTING new line(s)
  1450. 41005 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  1451. ' $PAGE
  1452. '
  1453. '  NAME    -- CheckTimeRemain
  1454. '
  1455. '  INPUTS  -- PARAMETER                 MEANING
  1456. '
  1457. '  OUTPUTS -- PARAMETER                 MEANING
  1458. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  1459. '             ZSecsUsedSession!     TIME USED IN SECONDS
  1460. '             ZSubParm              -1 IF No TIME LEFT
  1461. '
  1462.       SUB CheckTimeRemain (MinsRemaining) STATIC
  1463.       CALL TimeRemain (MinsRemaining)
  1464.       IF ZBypassTimeCheck THEN _
  1465.          EXIT SUB
  1466.       IF MinsRemaining <=3 AND NOT ZNonStop THEN _                   'ST119201
  1467.          CALL QuickTPut1 (ZFG7$ + "ALERT: AutoDisconnect in (" +  _  'ST119201
  1468.  STR$(MinsRemaining) + ") min.!" +ZColorReset$ + ZEmphasizeOff$) : _ 'Pe022493
  1469.          CALL PutCom (ZBellRinger$)                                  'ST119201
  1470.      GOTO 41009
  1471. 41007 IF MinsRemaining < 1 AND ZBankTime < 1  THEN _
  1472.         ZSubParm = -1 : _
  1473.          Return 
  1474.        ZOutTxt$ = ZFG1$+" Your Time has Expired"+ZFG2$+" - "+ZFG3$+ _
  1475.                     " Access The Time Bank  ([Y],N) "
  1476.        ZTurboKey = -ZTurboKeyUser
  1477.        CALL TGet
  1478.        IF ZSubParm = -1 THEN _
  1479.         Return
  1480.          IF ZNO THEN _
  1481.           ZSubParm = -1 : _
  1482.          return
  1483.         CALL BankTime
  1484.        IF MinsRemaining <= 0 THEN _
  1485.       ZSubParm = -1 : _
  1486.       return
  1487. * DELETING old line(s)
  1488. 41008
  1489. * INSERTING new line(s)
  1490. 41009  IF MinsRemaining < 1 THEN _
  1491.           GOSUB 41007
  1492.        IF ZSubParm = -1 Then _
  1493.           EXIT SUB
  1494.         END SUB
  1495. * REPLACING old line(s) by new
  1496. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  1497. ' $PAGE
  1498. '
  1499. '  NAME    -- DispTimeRemain
  1500. '
  1501. '  INPUTS  --     PARAMETER                    MEANING
  1502. '              MinsRemaining
  1503. '
  1504. '  OUTPUTS --     PARAMETER                    MEANING
  1505. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  1506. '
  1507.       SUB DispTimeRemain (MinsRemaining) STATIC
  1508.       CALL TimeRemain (MinsRemaining)
  1509.       CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left")
  1510. * ------[ first line different ]------
  1511.       Call Line25            'Pe 05/30/91
  1512.       END SUB
  1513. * REPLACING old line(s) by new
  1514. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  1515. ' $PAGE
  1516. '
  1517. '  NAME    -- Carrier
  1518. '
  1519. '  INPUTS  --     PARAMETER                    MEANING
  1520. '              ZAutoLogoffReq                  -1 if in autologoff request
  1521. '
  1522. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  1523. '              ZSubParm = -1                   TERMINATE (No Carrier)
  1524. '
  1525. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  1526. '              NOT to continue are:  autologoff, out of time, or
  1527. '              carrier dropped.
  1528. '
  1529. * ------[ first line different ]------
  1530.       SUB Carrier STATIC                                             ' KG010902
  1531.       'IF ZAutoLogoffReq THEN _
  1532.       '   IF NOT ZSuspendAutologoff THEN _
  1533.       '      ZSubParm = -1 : _
  1534.       '      EXIT SUB
  1535.       CALL CheckCarrier
  1536.       END SUB
  1537. * REPLACING old line(s) by new
  1538. 42020 ZSubParm = -1
  1539.       IF Speedy < -8 THEN _
  1540.          EXIT SUB
  1541.       IF AlreadyWritten = -9 THEN _
  1542.          EXIT SUB
  1543.       CALL TakeOffHook
  1544.       ZModemOffHook = -1
  1545.       AlreadyWritten = -9
  1546. * ------[ first line different ]------
  1547.       IF ZDoorCarrierDropOK$ = "Y" THEN _                             ' DD011801/DOORCARRIERDROP
  1548.          CALL UpdtCalr ("Logged Off from Door",1) : _                 ' DD011801/DOORCARRIERDROP
  1549.          EXIT SUB                                                     ' DD011801/DOORCARRIERDROP
  1550.       CALL UpdtCalr ("Carrier dropped",1)
  1551.       END SUB
  1552. * REPLACING old line(s) by new
  1553. * ------[ first line different ]------
  1554. 43007 Call GetRBBSString(109,RBBSString$)      'Pe 01/16/93
  1555.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1556.       CALL QuickTPut1 (OutTxt$)
  1557.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  1558.       ZSubParm = 1
  1559.       ZTurboKey = -ZTurboKeyUser
  1560.       CALL TGet
  1561.       IF ZSubParm = -1 THEN _
  1562.          EXIT SUB
  1563.       IF ZWasQ = 0 THEN _
  1564.          CALL QuickTPut1 ("Unchanged") : _
  1565.          EXIT SUB
  1566.       CALL AraAllCaps (ZUserIn$(),1)
  1567.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  1568.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  1569.     Call GetRBBSString(110,RBBSString$) : _      'Pe 01/16/93
  1570.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1571.          CALL QuickTPut1 (OutTxt$) : _
  1572.          GOTO 43007
  1573.       IF ZWasGR = 0 THEN _
  1574.          GOTO 43006
  1575.       ZWasGR = ZWasGR - 1
  1576.       CALL SetGraphic (ZWasGR)
  1577.       END SUB
  1578. '
  1579. * REPLACING old line(s) by new
  1580. 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
  1581. ' $PAGE
  1582. '
  1583. '  NAME    -- SaveProf
  1584. '
  1585. '  INPUTS  --     PARAMETER                    MEANING
  1586. '              ZBPS
  1587. '              ZEightBit
  1588. '              ZExitToDoors
  1589. '              ZWasGR
  1590. '              ZMsgRec$
  1591. '              ZNodeRecIndex
  1592. '              ZSysop
  1593. '              ZUpperCase
  1594. '              ZTimeLoggedOn$
  1595. '              ZPrivateDoor
  1596. '              ZReliableMode
  1597. '
  1598. '  OUTPUTS -- NONE
  1599. '
  1600. '  PURPOSE -- Saves a user's options and communications parameters
  1601. '             in the node record when a user exits to a "door" so
  1602. '             that he is in the same status as when he exited.
  1603. '
  1604.       SUB SaveProf (IParm) STATIC
  1605. * ------[ first line different ]------
  1606.       ON IParm GOTO 43070,43080,43075
  1607. * REPLACING old line(s) by new
  1608. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  1609.       ZSubParm = 3
  1610.       CALL FileLock
  1611.       CALL OpenMsg
  1612.       FIELD 1, 128 AS ZMsgRec$
  1613.       GET 1,ZNodeRecIndex
  1614.       IF ZGlobalSysop THEN _
  1615.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  1616.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  1617.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  1618. * ------[ first line different ]------
  1619.       MID$(ZMsgRec$,44,2) = RIGHT$(STR$(-ZBPS),2)    ' KG032604 ' MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  1620.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  1621.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2)
  1622.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  1623.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  1624.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZOrigTimeLoggedOn$,2))) + _
  1625.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,4,2))) + _
  1626.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,7,2)))
  1627.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  1628.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  1629.       MID$(ZMsgRec$,75,1) = ZWasFT$
  1630.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  1631.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  1632.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  1633.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  1634.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  1635.       IF ZLocalUser THEN _
  1636.          ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _
  1637.       ELSE ZWasZ$ = " 0"
  1638.       MID$(ZMsgRec$,101,2) = ZWasZ$
  1639.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
  1640.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  1641.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  1642.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  1643.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  1644.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  1645.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  1646.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  1647.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  1648.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  1649. ' ***   Save additional parameters for door restoral
  1650. * INSERTING new line(s)
  1651. 43075 CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1652.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  1653.       CALL PrintWorkA (ZWasNG$)
  1654.       CALL PrintWorkA (ZIndivValue$)
  1655.       CALL PrintWorkA (ZOrigDateTimeOn$)
  1656.       CALL PrintWorkA (ZOrigTimeLoggedOn$)
  1657.       CALL PrintWorkA (STR$(ZUserFileIndex))
  1658.       CALL PrintWorkA (ZUpldDir$)
  1659.       ZOutTxt$ = STR$(ZUpldDir$ = ZFMSDirectory$ OR ZLimitSearchToFMS)
  1660.       CALL PrintWorkA (ZOutTxt$)
  1661.       CALL PrintWorkA (ZCBaud$)
  1662.       CALL PrintWorkA (STR$(ZCanANSIChat))                           ' DD071901/ANSICHAT
  1663.       CALL PrintWorkA (STR$(ZBankTime))        'lk 08/17/91 Save for Xpress
  1664.       CALL PrintWorkA (STR$(ZBPS))                   'Pe 07/11/92
  1665.       Call PrintWorkA (STR$(ZCBPS))                  'Pe 07/11/92
  1666.       Call PrintWorkA (ZLastDateTimeOn$)             'Pe 12/20/92
  1667.       Call PrintWorkA (ZCityState$)                  'Pe 12/23/92
  1668.       Call PrintWorkA (ZListNewDate$)                'Pe 12/23/92
  1669.       CALL PrintWorkA (STR$(ZLastMsgRead))           'Pe 01/30/93
  1670.       Call PrintWorkA (ZBankTime$)                   'Pe 01/30/93
  1671.       Call PrintWorkA (ZDoorDropFile$)               'Pe 02/02/93
  1672.       CLOSE 2
  1673. Call MenuPlus (5)            ' Pe 02/08/93  Menu174
  1674.  
  1675. If IPARM = 3 Then Exit Sub       'Pe 07/12/92
  1676. * REPLACING old line(s) by new
  1677. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  1678. ' $PAGE
  1679. '
  1680. '  NAME    -- ReadProf
  1681. '
  1682. '  INPUTS  --     PARAMETER                    MEANING
  1683. '              ZNodeRecIndex               NODE RECORD TO USE
  1684. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  1685. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  1686. '
  1687. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  1688. '             UPON EXITING RBBS-PC TO A "DOOR"
  1689. '
  1690. '  PURPOSE -- Reset a user's options and communications parameters
  1691. '             that were saved in the node record when a user exited
  1692. '             to a "door" so that he is in the same status as when
  1693. '             he exited.
  1694. '
  1695. * ------[ first line different ]------
  1696.       SUB ReadProf (Iparm)STATIC
  1697. On Iparm Goto 44001,44005
  1698. * INSERTING new line(s)
  1699. 44001  FIELD 1, 128 AS ZMsgRec$
  1700.       GET 1,ZNodeRecIndex
  1701.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  1702.       MID$(ZMsgRec$,40,2) = "00"
  1703.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  1704.       ZBPS = -VAL(MID$(ZMsgRec$,44,2))        ' ZBPS = VAL(MID$(ZMsgRec$,44,2))
  1705.       CALL CommInfo
  1706.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  1707.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  1708.       ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))
  1709.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  1710.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  1711.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  1712.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  1713.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  1714.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  1715.                         ":" + _
  1716.                         MinLoggedOn$ + _
  1717.                         ":" + _
  1718.                         SecLoggedOn$
  1719.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  1720.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  1721.       ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2))
  1722.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  1723.       CALL Trim (ZDooredTo$)
  1724. '      IF ZExitToDoors AND ZDooredTo$ <> "" THEN 
  1725.       IF ZDooredTo$ <> "" Then _                     'Pe 01/30/93
  1726.          CALL OpenWork (2,ZDoorsDef$) : _
  1727.          IF ZErrCode = 0 THEN _
  1728.             CALL ReadParms (ZOutTxt$(),10,1) : _           'Pe 01/30/93     ' DD011801/DOORCARRIERDROP
  1729.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  1730.                CALL ReadParms (ZOutTxt$(),10,1) : _          'Pe 01/30/93         ' DD011801/DOORCARRIERDROP
  1731.             WEND : _
  1732.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  1733.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y")
  1734.             ZDoorDropFile$ = ZOutTxt$(9)                             ' Pe 01/30/93
  1735.             ZDoorCarrierDropOK$ = ZOutTxt$(10)                       ' DD011801/DOORCARRIERDROP
  1736.       ZErrCode = 0
  1737.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  1738.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  1739.       CALL Remove (ZCurPUI$," ")
  1740.       IF ZCurPUI$ <> "" THEN _
  1741.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  1742.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  1743.       ZCustomPUI = (ZCurPUI$ <> "")
  1744.       ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$)
  1745.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  1746.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  1747.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  1748.       CALL Trim (ZHomeConf$)
  1749.       IF ZHomeConf$ = "MAIN" THEN _
  1750.          ZHomeConf$ = ""
  1751.       IF ZRequiredRings > 0 AND _
  1752.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  1753.          COLOR 7,0,0 _
  1754.       ELSE COLOR ZFG,ZBG,ZBorder
  1755.       IF ZLocalUserMode THEN _
  1756.          GOTO 44003
  1757.       CALL SetBaud
  1758. * REPLACING old line(s) by new
  1759. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _
  1760.                         VAL(MinLoggedOn$) * 60! + _
  1761.                         VAL(SecLoggedOn$)
  1762.       HourLoggedOn$ = ""
  1763.       MinLoggedOn$ = ""
  1764.       SecLoggedOn$ = ""
  1765.       IF ZMinsPerSession < 1 THEN _
  1766.          ZMinsPerSession = 3
  1767.       IF NOT ZEightBit THEN _
  1768.          OUT ZLineCntlReg,&H1A
  1769.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  1770.          ZFirstName$ = ZSysopPswd1$ : _
  1771. * ------[ first line different ]------
  1772.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  1773.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  1774.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  1775.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  1776.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  1777.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  1778.       ZWasZ$ = ZFirstName$
  1779. * INSERTING new line(s)
  1780. 44005 CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1781.       CALL ReadDir (2,1)
  1782.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  1783.       CALL ReadDir (2,1)
  1784.       ZWasNG$ = ZOutTxt$
  1785.       CALL ReadDir (2,1)
  1786.       ZIndivValue$ = ZOutTxt$
  1787.       CALL ReadDir (2,1)
  1788.       ZOrigDateTimeOn$ = ZOutTxt$
  1789.       CALL ReadDir (2,1)
  1790.       ZOrigTimeLoggedOn$ = ZOutTxt$
  1791.       CALL ReadDir (2,1)
  1792.       ZUserFileIndex = VAL(ZOutTxt$)
  1793.       CALL ReadDir (2,1)
  1794.       ZUpldDoor$ = ZOutTxt$
  1795.       CALL ReadDir (2,1)
  1796.       ZFMSDoor = VAL(ZOutTxt$)
  1797.       CALL ReadDir (2,1)
  1798.       ZCBaud$ = ZOutTxt$
  1799.       CALL ReadDir (2,1)                                             ' DD071901/ANSICHAT
  1800.       ZCanANSIChat = VAL(ZOutTxt$)
  1801.       CALL ReadDir (2,1)                          'lk 08/17/91  Xpress
  1802.       ZTempBankTime = VAL(ZOutTxt$)              'lk 08/17/91 for Xpress
  1803.       CALL ReadDir (2,1)                          'Pe 07/11/92
  1804.       ZBPS = Val(ZOutTxt$)                        'Pe 07/11/92
  1805.       CALL ReadDir (2,1)                          'Pe 07/11/92
  1806.       ZCBPS = Val(ZOutTxt$)                       'Pe 07/11/92
  1807.       CALL ReadDir (2,1)                          'Pe 12/20/92
  1808.       ZLastDateTimeOn$ = ZOutTxt$                 'Pe 12/20/92
  1809.       Call ReadDir (2,1)                          'Pe 12/23/92
  1810.       ZCityState$ = ZOutTxt$                      'Pe 12/23/92
  1811.       Call ReadDir (2,1)                          'Pe 12/23/92
  1812.       ZListNewDate$ = ZOutTxt$                    'Pe 12/23/92
  1813.       CALL ReadDir (2,1)                          'Pe 01/30/93
  1814.       ZLastMsgRead = VAL(ZOutTxt$)                'Pe 01/30/93
  1815.       Call ReadDir (2,1)                          'Pe 01/30/93
  1816.       ZBankTime$ = ZOutTxt$                     'Pe 01/30/93
  1817.       CALL ReadDir (2,1)                        'Pe 02/02/93
  1818.       ZDoorDropFile$ = ZOutTxt$                 'Pe 02/02/93
  1819.       CLOSE 2
  1820.       Call MenuPlus(8)                          ' Pe Menu174
  1821.       CALL DoorReturn
  1822.       END SUB
  1823. * REPLACING old line(s) by new
  1824. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  1825. ' $PAGE
  1826. '
  1827. '  NAME    -- CommInfo
  1828. '
  1829. '  INPUTS  --     PARAMETER                    MEANING
  1830. '                 ZBPS                BAUD RATE INDICATOR
  1831. '                 ZEightBit           INDICATE FOR N/8/1
  1832. '
  1833. '  OUTPUTS -- ZBaudParity$
  1834. '
  1835. '  PURPOSE -- Create a string that shows a users baud rate and parity
  1836. '
  1837.       SUB CommInfo STATIC
  1838. '
  1839. '
  1840. ' *  DETERMINE BAUD AND PARITY
  1841. '
  1842. '
  1843.   IF ZReliableMode THEN _
  1844.      ReliableMode$ = "-R," _
  1845.   ELSE ReliableMode$ = ","
  1846.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  1847. * ------[ first line different ]------
  1848.                  " BPS" + _                             'Pe 021693
  1849.                  ReliableMode$ + _
  1850.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  1851.   ZBaudTest! = VAL(ZBaudParity$)
  1852.   END SUB
  1853. * REPLACING old line(s) by new
  1854. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  1855. ' $PAGE
  1856. '
  1857. '  NAME    -- DispCall
  1858. '
  1859. '  INPUTS  --     PARAMETER           MEANING
  1860. '
  1861. '  OUTPUTS --  (NONE)
  1862. '
  1863. '  PURPOSE -- Displays callers file to sysops and callers
  1864. '
  1865.       SUB DispCall STATIC
  1866.       IF ZCallersFilePrefix$ = "" THEN _
  1867.          EXIT SUB
  1868.       PrevCal$ = ZCallersFile$
  1869.       OrigCal$ = ZCallersFile$
  1870. * ------[ first line different ]------
  1871.       IF (ZUserSecLevel < ZSysopSecLevel) THEN _
  1872.          GOTO 57004
  1873.       CALL LinesInFile (ZCallersLst$,NumItems)
  1874.       IF NumItems < 1 THEN _
  1875.          GOTO 57004
  1876.       IF ZAnsIndex < ZLastIndex THEN _
  1877.          GOTO 57003
  1878. * REPLACING old line(s) by new
  1879. * ------[ first line different ]------
  1880. 57002 Call GetRBBSString(111,RBBSString$)      'Pe 01/16/93
  1881.       OutTxt$ = RBBSString$                'Pe 01/16/93
  1882.       CALL QuickTPut1 (OutTxt$)
  1883.       ZNo = ZFalse
  1884.       LineCt = 0
  1885.       CALL OpenWork (2, ZCallersLst$)
  1886.       WHILE (NOT ZNo) AND (NOT EOF(2))
  1887.          LineCt = LineCt + 1
  1888.          CALL ReadDir (2,1)
  1889.          Temp = INSTR(ZOutTxt$," ")
  1890.          IF Temp = 0 THEN _
  1891.             ZOutTxt$ = " ???" _
  1892.          ELSE ZOutTxt$ = MID$(ZOutTxt$,Temp)
  1893.          ZOutTxt$ = "  " + STR$(LineCt) + "  - " + ZOutTxt$
  1894.          ZSubParm = 5
  1895.          CALL TPut
  1896.          CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  1897.       WEND
  1898. * REPLACING old line(s) by new
  1899. * ------[ first line different ]------
  1900. 57003   Call GetRBBSString(298,RBBSString$)      'Pe 01/16/93
  1901.       ZOutTxt$ = RBBSString$ + MID$(STR$(NumItems),2) + ")"
  1902.       CALL PopCmdStack
  1903.       WasDF$ = ZUserIn$(ZAnsIndex)
  1904.       CALL AllCaps (WasDF$)
  1905.       IF WasDF$ = "L" THEN _
  1906.          GOTO 57002
  1907.       CALL CheckInt (WasDF$)
  1908.       IF ZTestedIntValue <= 0 THEN _
  1909.          GOTO 57102
  1910.       IF ZTestedIntValue > NumItems THEN _
  1911.             GOTO 57003
  1912.       CALL OpenWork (2,ZCallersLst$)
  1913.       CALL ReadDir (2, ZTestedIntValue)
  1914.       ZCallersFile$ = LEFT$(ZOutTxt$,INSTR(ZOutTxt$+" "," ")-1)
  1915.       CALL FindIt (ZCallersFile$)
  1916.       CLOSE 2
  1917.       IF NOT ZOK THEN _
  1918.     Call GetRBBSString(112,RBBSString$) : _      'Pe 01/16/93
  1919.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1920.          Call QuickTPut1 (OutTxt$ + ZCallersFile$+"> found") : _
  1921.          ZCallersFile$ = PrevCal$ : _
  1922.          GOTO 57003
  1923.       IF PrevCal$ <> ZCallersFile$ THEN _
  1924.          CALL SetCall
  1925. * REPLACING old line(s) by new
  1926. 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
  1927. * ------[ first line different ]------
  1928.          CLOSE 4 : _                                ' Pe 07/09/92
  1929.          GOTO 57101
  1930. * REPLACING old line(s) by new
  1931. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  1932.       GET 4,CallersFileIndexTemp!
  1933.       WasZ = INSTR(ZCallersRecord$,"{")
  1934.       IF WasZ < 1 OR WasZ > 15 THEN _
  1935.          WasZ = 15
  1936. * ------[ first line different ]------
  1937.       IF ZSysop OR _
  1938.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  1939.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  1940.       GOSUB 57100
  1941.       IF ZSysop THEN _
  1942.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  1943.          GOSUB 57100
  1944.       GOTO 57045
  1945. * REPLACING old line(s) by new
  1946. * ------[ first line different ]------
  1947. 57030 IF ZSysop THEN _
  1948.          GOSUB 57100
  1949. * REPLACING old line(s) by new
  1950. * ------[ first line different ]------
  1951. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  1952.          IF NOT ZSysop THEN _
  1953.             RETURN
  1954.       IF ZJumpSearching THEN _
  1955.          ZWasDF$ = ZOutTxt$ : _
  1956.          CALL AllCaps (ZWasDF$) : _
  1957.          IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  1958.             RETURN _
  1959.          ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  1960.               ZJumpSearching = ZFalse
  1961.       ZSubParm = 5
  1962.       CALL TPut
  1963.       WasX = 1
  1964.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  1965.       IF ZSubParm = -1 THEN _                                        ' RH070402
  1966.          GOTO 57102 _                                                ' RH070402
  1967.       ELSE IF ZNo THEN _                                             ' RH070402
  1968.          GOTO 57101                                                  ' RH070402
  1969.       RETURN
  1970. * REPLACING old line(s) by new
  1971. * ------[ first line different ]------
  1972. 57101 IF WasX < 999 AND ZSysOp AND NumItems > 1 THEN _
  1973.          PrevCal$ = ZCallersFile$ : _
  1974.          GOTO 57003
  1975. * REPLACING old line(s) by new
  1976. 57102 ZJumpSupported = ZFalse
  1977. * ------[ first line different ]------
  1978.       IF OrigCal$ <> ZCallersFile$ THEN _                            ' RH070401
  1979.          ZCallersFile$ = OrigCal$ : _
  1980.          CALL SetCall
  1981.       END SUB
  1982. * REPLACING old line(s) by new
  1983. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  1984. ' $PAGE
  1985. '
  1986. '  NAME    -- CheckNewBul
  1987. '
  1988. '  INPUTS  --     PARAMETER           MEANING
  1989. '                 LastOn$             Last DATE OF LOGON
  1990. '                                   FORMAT MM/DD/YY
  1991. '                 ZActiveBulletins  # OF BULLETING
  1992. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  1993. '
  1994. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  1995. '                 NewBullets$      LIST OF NEW BULLET #'S
  1996. '                 ZWasQ            WHERE Last BULLETIN STORED
  1997. '                                  IN ZUserIn$()
  1998. '                 ZOutTxt$()       BULLETINS #'S THAT ARE NEW
  1999. '                                    (2,3,4,...)
  2000. '
  2001. '  PURPOSE -- Checks how many bulletins have system date
  2002. '             at or later than date caller last logged on
  2003. '
  2004.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  2005.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  2006.          EXIT SUB
  2007.       ZPrevPrefix$ = ZBulletinPrefix$
  2008.       NumNewBullets = 0
  2009.       NewBullets$ = ""
  2010.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  2011.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  2012.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  2013.       WasX = 0
  2014. * ------[ first line different ]------
  2015.     Call GetRBBSString(113,RBBSString$)      'Pe 01/16/93
  2016.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  2017.       CALL QuickTPut (OutTxt$,0)
  2018.       IF ZOK THEN _
  2019.          WHILE NOT EOF(2) : _
  2020.             INPUT #2,WasBN$ : _
  2021.             GOSUB 58112 : _
  2022.          WEND _
  2023.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  2024.               WasBN$ = MID$(STR$(WasI),2) : _
  2025.               GOSUB 58112 : _
  2026.            NEXT
  2027.       ZWasQ = NumNewBullets + 1
  2028.       IF NumNewBullets < 1 THEN _
  2029.          NewBullets$ = ""
  2030.       CALL SkipLine (1)
  2031.     Call GetRBBSString(114,RBBSString$) : _      'Pe 01/16/93
  2032.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2033.       ZOutTxt$ = STR$(NumNewBullets) + OutTxt$
  2034.       CALL QuickTPut1 (ZOutTxt$)
  2035.       CALL BufString (NewBullets$,4096,WasX)
  2036.       CALL SkipLine (1)
  2037.       EXIT SUB
  2038. * REPLACING old line(s) by new
  2039. 58141 PrevLoadNew$ = ZFMSDirectory$
  2040.       CALL OpenFMS (LastRec,WasL)
  2041.       FIELD 2, 23 AS PreDate$, _
  2042.                 2 AS WasMM$, _
  2043.                 1 AS Fill1$, _
  2044.                 2 AS WasDD$, _
  2045.                 1 AS Fill2$, _
  2046.                 2 AS Year$, _
  2047. * ------[ first line different ]------
  2048.                 (2 + ZMaxDescLen) AS ZDesc$, _
  2049.                 3 AS Category$, _
  2050.                 2 AS Fill4$
  2051.       MaxRecs = UBOUND(Ara,1)
  2052.       IF MaxRecs < 1 THEN _
  2053.          MaxRecs = 1 _
  2054.       ELSE IF MaxRecs > 23 THEN _
  2055.               MaxRecs = 23
  2056.       WasL = 0
  2057.       WasK = LastRec
  2058.       WHILE WasK > 0 AND WasL < MaxRecs
  2059.          GET #2,WasK
  2060.          IF INSTR("*\ ",LEFT$(PreDate$,1)) > 0 THEN _
  2061.             GOTO 58142
  2062.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  2063.             IF VAL(Year$) > 79 THEN _
  2064.                WasL = WasL + 1 : _
  2065.                Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _
  2066.             ELSE IF FirstWarning THEN _
  2067.                     FirstWarning = ZFalse : _
  2068.                     ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _
  2069.                     ZSnoop = ZTrue : _
  2070.                     CALL LPrnt (ZWasZ$,1) : _
  2071.                     CALL UpdtCalr (ZWasZ$,2)
  2072.          IF NOT ZCanDnldFromUp THEN _
  2073.             WasX = ZMinSecToView _
  2074.          ELSE IF Category$ = "***" THEN _
  2075.                  WasX = ZSysopSecLevel _
  2076.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  2077.                       WasX = ZMinSecToView _
  2078.               ELSE IF LEFT$(PreDate$,1) = "=" THEN _
  2079.                       CALL CheckInt (ZDesc$) : _
  2080.                       WasX = ZTestedIntValue _
  2081.               ELSE WasX = ZOptSec(19)
  2082.          Ara(WasL,2) = WasX
  2083. * REPLACING old line(s) by new
  2084. 58165 ' $SUBTITLE: 'DispUpDir - sub to display FMS directory'
  2085. ' $PAGE
  2086. '
  2087. '  NAME    -- DispUpDir
  2088. '
  2089. '  INPUTS  -- PARAMETER             MEANING
  2090. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  2091. '                                 THE SEARCH.
  2092. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  2093. '                                 FILE "CATEGORIES" SELECTED
  2094. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  2095. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  2096. '                                 AND THE STRING TO SEARCH.
  2097. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  2098. '                                 VIEWING - 0 IF AT END
  2099. '
  2100. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  2101. '                                 TO 1.  OTHERWISE LEAVES AT ZERO
  2102. '  PURPOSE -- Display the files that meet the criteria selected in
  2103. '             RBBS-PC upload management system on the users screen.
  2104. '
  2105.       SUB DispUpDir (PassedCats$,SearchString$, _
  2106.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  2107.       IF AtEndList THEN _
  2108.          AtEndList = ZFalse : _
  2109.          IF DnldFlag > 0 THEN _
  2110.             GOSUB 58185 : _
  2111.             GOTO 58184
  2112.       CALL AllCaps (SearchString$)
  2113.       Blank$ = " "
  2114.       ZStopInterrupts = ZFalse
  2115.       Categories$ = "," + _
  2116.                     PassedCats$ + _
  2117.                     ","
  2118.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  2119.       CanView = (ZUserSecLevel => ZOptSec(26))
  2120.       ZJumpSupported = ZTrue
  2121.       ZJumpSearching = ZFalse
  2122.       GOSUB 58185
  2123.       OrigDir$ = ZActiveFMSDir$
  2124.       InList = (RelistAt > 0 AND ReListAt <= LastRec)
  2125.       IF InList AND DnldFlag > 0 THEN _
  2126.          UpldIndex = RelistAt : _
  2127.          DnldFlag = 0 : _
  2128.          GOTO 58179
  2129.       ZJumpLast$ = ""
  2130.       SearchFor$ = SearchString$
  2131. * ------[ first line different ]------
  2132.       ExtraPrompt$ = LEFT$(",T)ype",6+4*ZExpertUser)                 'Pe 10/21/89
  2133.       ExtraPrompt$ = ExtraPrompt$ + LEFT$(",V)iew",6+4*ZExpertUser)  'Pe 10/21/89
  2134.       IF ZPersonalDnld THEN _
  2135.          ExtraPrompt$ = ExtraPrompt$ + ",*)new"
  2136.       IF CanDnld THEN _
  2137.          ExtraPrompt$ = ExtraPrompt$ + ",E)xtra,M)ark,D)nld"    'Pe 11/07/91
  2138.       MaxPrint = ZPageLength - 1
  2139.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  2140.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  2141.       FMSCheckPoint = 0
  2142.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  2143.                      OR (INSTR(SearchString$,"*") > 0)
  2144.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  2145.       IF ZAnsIndex > 0 THEN _
  2146.         IF ZLastCommand$ = "FP" AND INSTR("Ll",ZUserIn$(ZLastIndex)) = 0 THEN _
  2147.             ZUserIn$(ZAnsIndex) = "D" : _
  2148.             IF (UpldIndex > 0 AND UpldIndex <= LastRec) THEN _
  2149.                GOTO 58180 _
  2150.             ELSE Temp$ = "" : _
  2151.                  GOTO 58196
  2152. * REPLACING old line(s) by new
  2153. 58174 IF SearchDate$ <> "" THEN _
  2154.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  2155.                 MID$(PartToPrint$,24,2) + _
  2156.                 MID$(PartToPrint$,27,2) : _
  2157.          IF HoldCat$ < SearchDate$ THEN _
  2158.             IF ZDateOrderedFMS THEN _
  2159. * ------[ first line different ]------
  2160.                GOTO 58184 _
  2161.             ELSE GOTO 58168
  2162. '
  2163. '
  2164. ' * Allow the FMS to be both fast and interruptable if a local
  2165. ' * user or there is nothing in the input buffer by using QuickTPut.
  2166. '
  2167. '
  2168. * REPLACING old line(s) by new
  2169. 58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _
  2170.          GOTO 58168
  2171.       CALL CheckCarrier
  2172.       IF ZSubParm = -1 THEN _
  2173.          GOTO 58198
  2174.       CALL TimeRemain (MinsRemaining)
  2175.       IF MinsRemaining <= 0 THEN _
  2176.          ZSubParm = -1 : _
  2177.          GOTO 58198
  2178.       IF ZNonStop THEN _
  2179.          GOTO 58168
  2180.       IF ZLinesPrinted <= MaxPrint THEN _
  2181.          IF ZDateOrderedFMS THEN _
  2182. * ------[ first line different ]------
  2183.     Call GetRBBSString(115,RBBSString$) : _      'Pe 01/16/93
  2184.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2185.             CALL QuickTPut1 (ZEmphasizeOff$ + _
  2186.                OutTxt$ + " " + MID$(PartToPrint$,24,8)) _
  2187.          ELSE _
  2188.             CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _
  2189.                " files checked")
  2190. * REPLACING old line(s) by new
  2191. 58180 WasX$ = ZUserIn$(ZAnsIndex)
  2192.       CALL AllCaps (WasX$)
  2193.       IF InList AND (ZAnsIndex >= ZLastIndex OR WasX$ <> "D") THEN _
  2194.          ZTurboKey = -ZTurboKeyUser : _
  2195.          ZStackC = ZTrue : _
  2196.          CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) : _
  2197.          IF ZSubParm = -1 THEN _
  2198.             EXIT SUB _
  2199.          ELSE ZLastIndex = ZWasQ :_
  2200. * ------[ first line different ]------
  2201.          IF NOT ZNo THEN _
  2202.             ZAnsIndex = 1
  2203.       IF ZSubParm = -1 THEN _
  2204.          GOTO 58198
  2205.       IF ZNo THEN _
  2206.          ZLastIndex = 0 : _
  2207.          GOTO 58198
  2208.       WasX$ = ZUserIn$(ZAnsIndex)
  2209.       CALL AllCaps (WasX$)
  2210. '
  2211. 'Type TXT file mod  Pe 10/21/89
  2212. '
  2213.       IF WasX$ = "T" THEN _
  2214.          CALL TypeFile : _
  2215.          ZwasA = UpldIndex : _
  2216.          GOSUB 58185 : _
  2217.          UpldIndex = ZwasA : _
  2218.          GOTO 58180
  2219. '
  2220. '
  2221.       IF WasX$ = "V" THEN IF CanView THEN _
  2222.          CALL GetArc : _
  2223.          ZJumpSupported = ZTrue : _
  2224.          ZWasA = UpldIndex : _
  2225.          GOSUB 58185 : _
  2226.          UpldIndex = ZWasA : _
  2227.          GOTO 58180
  2228. '
  2229. '   
  2230.      IF WasX$ = "E" THEN _                  'Pe 11/07/91
  2231.       ZExtendedOff=NOT ZExtendedOff: _       'Pe 11/07/91
  2232.     Call GetRBBSString(116,RBBSString$) : _      'Pe 01/16/93
  2233.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2234.       CALL QuickTPut1 (OutTxt$ + " "+FNOffOn$(NOT ZExtendedOff)) : _
  2235.       GOTO 58168
  2236. '
  2237. '
  2238. * REPLACING old line(s) by new
  2239. 58181 MarkingFiles = ZFalse
  2240. * ------[ first line different ]------
  2241.       IF ((WasX$ = "D" OR WasX$ = "M") AND CanDnld) OR (WasX$ = "V" AND CanView) THEN _ ' KG091001
  2242.  MarkingFiles = (WasX$ = "M") : _
  2243.          AtEndList = ZFalse : _                                  'PE 08/04/91
  2244.          CALL AskItems ("DMV",WasX$,ZTrue,"file",ZMarkedFiles$) ': _   ' KG091001
  2245.          IF ZWasQ = 0 THEN _
  2246.             GOTO 58183
  2247.       IF WasX$ = "*" THEN IF ZPersonalDnld THEN _
  2248.          GOTO 58193
  2249. * REPLACING old line(s) by new
  2250. 58183 IF ZJumpSearching THEN _
  2251.          PrevSearch$ = SearchFor$ : _
  2252.          SearchFor$ = ZJumpTo$ _
  2253.       ELSE SearchFor$ = SearchString$ : _
  2254.            IF NOT ZYes AND CanDnld THEN _
  2255.               GOSUB 58188 : _
  2256. * ------[ first line different ]------
  2257.               IF WasX$ = "V" AND CanView AND ZLastIndex >= ZAnsIndex THEN _ ' KG091001
  2258.                  ZAnsIndex = ZAnsIndex - 1 : _                       ' KG091001
  2259.                  CALL GetArc : _                                     ' KG091001
  2260.                  ZJumpSupported = ZTrue : _                          ' KG091001
  2261.                  ZWasA = UpldIndex : _                               ' KG091001
  2262.                  GOSUB 58185 : _                                     ' KG091001
  2263.                  UpldIndex = ZWasA : _                               ' KG091001
  2264.                  GOTO 58180 _                                        ' KG091001
  2265.  ELSE IF WasX$ <> "L" AND ZLastIndex >= ZAnsIndex AND NOT MarkingFiles AND NOT AtEndList THEN _ ' Pe 080391
  2266.                  CALL SkipLine (1) : _
  2267.                  DnldFlag = 1 : _
  2268.                  ReListAt = UpldIndex : _
  2269.                  EXIT SUB _
  2270.               ELSE IF UpldIndex = CutoffRec THEN _
  2271.                       GOTO 58184
  2272.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  2273.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  2274.          Call GetRBBSString(299,RBBSString$): _      'Pe 01/16/93
  2275.             ZOutTxt$ = STR$(UpldIndex) + RBBSString$ : _
  2276.             ZNoAdvance = ZTrue : _
  2277.             ZTurboKey = -ZTurboKeyUser : _
  2278.             ZSubParm = 1 : _
  2279.             CALL TGet : _
  2280.             CALL WipeLine (79) : _
  2281.             ZNonStop = ZYes
  2282.       GOTO 58168
  2283. * REPLACING old line(s) by new
  2284. 58184 IF ZChainedDir$ <> "" THEN _
  2285.          ZActiveFMSDir$ = ZChainedDir$ : _
  2286.          GOSUB 58185 : _
  2287.          LastFName = 0 : _
  2288.          GOTO 58168
  2289. * ------[ first line different ]------
  2290.       IF ZNo THEN _
  2291.          GOTO 58198
  2292.       Temp$ = "End list. "
  2293.       AtEndList = ZTrue
  2294.       UpldIndex = CutOffRec - ZUpInc
  2295.       ZLastIndex = 0
  2296.       GOTO 58196
  2297. * REPLACING old line(s) by new
  2298. 58185 IF PassedCats$ = "P" THEN _
  2299.          ZActiveFMSDir$ = ZPersonalDir$
  2300.       CALL OpenFMS (UpldIndex,CatLen)
  2301.       LastRec = UpldIndex
  2302.       EndDesc = 33 + ZMaxDescLen
  2303.       IF CatLen > 3 THEN _
  2304.          Categories$ = ZActiveUserName$ : _
  2305.          CALL Trim (Categories$) : _
  2306.          Categories$ = "," + Categories$ + "," + LEFT$(",SYSOP,",-7*ZSysOp) : _
  2307.          CanDnld = ZTrue : _
  2308.          StatLen = 1 _
  2309.       ELSE StatLen = 0
  2310. * ------[ first line different ]------
  2311.       FIELD 2, EndDesc AS PartToPrint$, _
  2312.                CatLen AS Category$, _
  2313.                StatLen AS PersonalStatus$, _
  2314.                2 AS Filler$
  2315.       PrevFMS$ = ZActiveFMSDir$
  2316. * REPLACING old line(s) by new
  2317. 58188 IF ProcessedNew OR MarkingFiles OR NOT ZListOnly THEN _
  2318.          ProcessedNew = ZFalse : _
  2319.          RETURN
  2320.       ZUserIn$(0) = ""
  2321.       WasI = ZAnsIndex              ' check whether in dir
  2322.       WHILE WasI <= ZLastIndex
  2323.          CALL AraAllCaps (ZUserIn$(),WasI)
  2324.          ZWasZ$ = ZUserIn$(WasI)
  2325.          CALL UnMarkItems (ZMarkedFiles$,WasI,ZLastIndex,WasX,ZTrue)
  2326.          Temp$ = ZUserIn$(WasI)
  2327. * ------[ first line different ]------
  2328.          CALL AllCaps (Temp$)                                        ' KG062401
  2329.          IsProto = (LEN(Temp$) = 1 AND _
  2330.                     INSTR(ZDefaultXfer$,Temp$) > 0)
  2331.          ZOK = IsProto
  2332.          WasJ = LastRec + 1
  2333.          WasX = INSTR(Temp$,".")
  2334.          AltTemp$ = ""
  2335.          IF NOT IsProto THEN _
  2336.             IF WasX = 0 THEN _
  2337.                AltTemp$ = Temp$ + "." + ZDefaultExtension$ _
  2338.             ELSE IF WasX = LEN(Temp$) THEN _
  2339.                     AltTemp$ = LEFT$(Temp$,WasX-1)
  2340.          WHILE WasJ > 1 AND NOT ZOK
  2341.             WasJ = WasJ - 1
  2342.             GET #2,WasJ
  2343.             GOSUB 58191
  2344.             IF CanGet THEN _
  2345.                MID$(PartToPrint$,13,1) = " " : _
  2346.                ZWasY$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) : _ ' KG091001
  2347.                ZOK = (Temp$ = ZWasY$) : _                            ' KG091001
  2348.                IF NOT ZOK THEN _
  2349.                   IF AltTemp$ <> "" THEN _
  2350.                      ZOK = (AltTemp$ = ZWasY$)                       ' KG091001
  2351.          WEND
  2352.          IF ZOK THEN _
  2353.             GOSUB 58189 : _
  2354.             IF ZOK OR IsProto THEN _
  2355.                ZWasY$ = MID$(STR$(WasJ),2) : _                       ' KG091001
  2356.                ZUserIn$(0) = ZUserIn$(0) + _
  2357.                        ZWasY$ + _                                    ' KG091001
  2358.                        SPACE$(5 - LEN(ZWasY$))                       ' KG091001
  2359.          IF NOT ZOK AND NOT IsProto THEN _
  2360.     Call GetRBBSString(70,RBBSString$) : _      'Pe 01/16/93
  2361.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2362.             CALL QuickTPut1 (ZWasZ$ + OutTxt$ + " - omitted") : _
  2363.             FOR WasK = WasI + 1 TO ZLastIndex : _
  2364.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  2365.             NEXT : _
  2366.             ZLastIndex = ZLastIndex - 1 : _
  2367.             WasI = WasI - 1
  2368.          WasI = WasI + 1
  2369.       WEND
  2370.       ZWasQ = ZLastIndex
  2371.       RETURN
  2372. * REPLACING old line(s) by new
  2373. 58189 IF IsProto THEN _
  2374.          RETURN
  2375.       ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  2376.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  2377.       IF ZOK THEN _
  2378.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  2379. * ------[ first line different ]------
  2380.      ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  2381.                       ((ZUserSecLevel < ZMinSecToView) OR _
  2382.                        NOT ZCanDnldFromUp),ZTrue,"D") : _
  2383.            GOSUB 58185
  2384.       RETURN
  2385. * REPLACING old line(s) by new
  2386. 58196 CALL QuickTPut (ZEmphasizeOff$,0)
  2387. * ------[ first line different ]------
  2388.       ZOutTxt$ = Temp$ + "L)ist,A)bort,T)ype,V)iew," + _             ' Pe 03/30/92
  2389.                  LEFT$("*)dnld new,",-11*ZPersonalDnld) + _
  2390.                  "M)ark" + LEFT$(",D)ownload",-10*CanDnld) + ZPressEnterExpert$
  2391.       ZTurboKey = -ZTurboKeyUser
  2392. If ZDnldCompleted and ZAutoEnd = 1 THEN _   'Pe 10/22/91
  2393.          ZNonStop = ZTrue : _                            ' DD092501
  2394.          ZStopInterrupts = ZTrue : _                     ' DD092501
  2395.          ZAutoLogOffReq = ZTrue : _                      ' DD092501
  2396.          GOTO 58199                                      ' DD092501
  2397.       CALL PopCmdStack
  2398.       WasX$ = ZUserIn$(ZAnsIndex)
  2399.       CALL AllCaps (WasX$)
  2400.            IF WasX$ = "A" THEN _                         ' DD012304
  2401.          ZLastIndex = 0 : _                              ' DD012304
  2402.          ZRet = ZTrue                                    ' DD012304
  2403.       IF ZWasQ = 0 OR ZRet OR ZSubParm < 0 THEN _
  2404.          GOTO 58198
  2405. '
  2406.       IF WasX$ = "L" THEN _
  2407.          ZActiveFMSDir$ = OrigDir$ : _
  2408.          GOSUB 58185 : _
  2409.          AtEndList = ZFalse : _
  2410.          GOTO 58168   
  2411. '
  2412. 'Type TXT file mod  Pe 10/21/89
  2413. '
  2414.       IF WasX$ = "T" THEN _
  2415.          CALL TypeFile : _
  2416.          ZwasA = UpldIndex : _
  2417.          GOSUB 58185 : _
  2418.          UpldIndex = ZwasA : _
  2419.          GOTO 58180
  2420. '
  2421. '
  2422.       IF WasX$ = "V" THEN IF CanView THEN _
  2423.          CALL GetArc : _
  2424.          ZJumpSupported = ZTrue : _
  2425.          ZWasA = UpldIndex : _
  2426.          GOSUB 58185 : _
  2427.          UpldIndex = ZWasA : _
  2428.          GOTO 58180
  2429.          ZYes = ZFalse 
  2430.          Goto 58181
  2431. * REPLACING old line(s) by new
  2432. 58198 CLOSE 2
  2433.       ZNonStop = (ZPageLength < 1)
  2434.       ZStopInterrupts = ZFalse
  2435. * ------[ first line different ]------
  2436. * INSERTING new line(s)
  2437. 58199 ZOutTxt$ = ""                                      ' DD092501
  2438.       ZActiveFMSDir$ = ""
  2439.       ZJumpSupported = ZFalse
  2440.       DnldFlag = 0
  2441.       EXIT SUB
  2442.       END SUB
  2443. '
  2444. ' $SUBTITLE: 'TypeFile - subroutine to TYPE an ASCII FILE'
  2445. ' $PAGE
  2446. '
  2447. '  NAME    -- TYPEAFILE
  2448. '
  2449. '  PARAMETERs          
  2450. '                      
  2451. '                      
  2452. '                      
  2453. '
  2454. '  PURPOSE -- Type a ASCII file to screen
  2455. '
  2456.       SUB TypeFile STATIC
  2457. 59141 CALL SkipLine (1)
  2458.          Call GetRBBSString(300,RBBSString$)     'Pe 01/16/93
  2459.        ZOutTxt$ = RBBSString$+ZPressEnterExpert$
  2460.         CALL PopCmdStack
  2461.        IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2462.       EXIT SUB
  2463. 59142 ZViolation$ = "TYPE File"
  2464.       WasX = ZAnsIndex
  2465.      FOR ZAnsIndex = WasX TO ZLastIndex
  2466.       GOSUB 59143
  2467.         IF ZSubParm < 0 THEN _
  2468.        ZAnsIndex = ZLastIndex + 1
  2469.       NEXT ZAnsIndex
  2470.       IF ZLastIndex > 1 THEN _
  2471.          EXIT SUB _
  2472.       ELSE GOTO 59141
  2473. 59143  WasZ$ = ZUserIn$(ZAnsIndex)
  2474.        CALL AllCaps (WasZ$)
  2475.     IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  2476.     Call GetRBBSString(51,RBBSString$) : _      'Pe 01/16/93
  2477.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2478.    CALL QuickTPut (OutTxt$,1) : _
  2479.     RETURN
  2480.        ZFileName$ = WasZ$
  2481.         ZFileNameHold$ = WasZ$
  2482.          CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  2483.         ON BadFileNameIndex GOTO 59145,59148,59150
  2484. 59145 CALL BadName (BadFileNameIndex,ZTrue)          'Pe 06/03/91
  2485.       ON BadFileNameIndex GOTO 59146,59150
  2486. 59146 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") 'Pe 02/25/90
  2487.        IF ZOK THEN _        ' Pe 02/06/90
  2488.         GOTO 59158
  2489. '
  2490. '**********************8 Pe 08/12/91 next 5 lines *********
  2491. If ZPersonalDnld Then _
  2492.   ZFileName$ = ZPersonalDrvPath$ + WasZ$ : _
  2493. CALL FindFile (ZFileName$,ZOK)
  2494.  IF ZOK THEN _
  2495.     GOTO 59158
  2496. '************************************************************
  2497. 59148 WasZ$ = ZUserIn$(ZAnsIndex) + _
  2498.            " not found!"
  2499.       CALL UpdtCalr (WasZ$,2)
  2500.       ZOutTxt$ = WasZ$ + _
  2501.            " Type correct filename" + ZPressEnterExpert$
  2502.       ZSubParm = 1
  2503.       CALL TGet
  2504.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2505.          RETURN
  2506.       ZUserIn$(ZAnsIndex) = ZUserIn$(1) 
  2507.       GOTO 59143
  2508. 59150 CALL SecViolation
  2509.       IF ZDenyAccess THEN _
  2510.          EXIT SUB
  2511.       GOTO 59148
  2512. 59158 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
  2513.       IF Ext$ = "" THEN _
  2514.         GOTO 59160
  2515.       IF INSTR("DWC,COM,EXE,GIF,PIC,DAT,BIN,ZIP,ARC,LZH,ZOO,PAK,ARJ,",Ext$+",") > 0 THEN _
  2516.     Call GetRBBSString(117,RBBSString$) : _      'Pe 01/16/93
  2517.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2518.  CALL QuickTPut (OutTxt$ + " " +Ext$ ,1) : _
  2519.          RETURN
  2520. 59160  CALL BufFile (ZFileName$,WasX) 
  2521.        RETURN
  2522.        END SUB
  2523. '************************ Pe 01/25/92  to end of file **************
  2524. '
  2525. ' $SUBTITLE: 'WhoDidIt - subroutine to Display Who Uploaded that file'
  2526. ' $PAGE
  2527. '
  2528. '  NAME    -- WhoDidIt
  2529. '
  2530. '  PARAMETERs None
  2531. '                      
  2532. '                      
  2533. '                      
  2534. '
  2535. 'PURPOSE - Maple Version of RBBS creates a file Called Uploadlg.def
  2536. '          this file keeps track of who Uploaded what file
  2537. '          File location is Drive/Path were *.DIR files are stored 'Pe 03/13/92
  2538. '          Allows reading UPLOADLG.DEF file in reverse order
  2539. '
  2540.       SUB WhoDidIt STATIC
  2541. 59500 CALL SkipLine (3)
  2542.     Call GetRBBSString(118,RBBSString$)      'Pe 01/16/93
  2543.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  2544. Call QuickTput1 (OutTxt$)
  2545.     Call GetRBBSString (119,RBBSString$)
  2546.       OutTxt$ = RBBSString$
  2547.     Call Quicktput1 (OutTxt$)
  2548.     Call GetRBBSString(118,RBBSString$)      'Pe 01/16/93
  2549.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  2550. Call QuickTput1(OutTxt$)
  2551.     Close 8
  2552.    IF ZShareIt THEN _
  2553.      OPEN ZDirPath$ +"UPLOADLG.DEF" FOR RANDOM SHARED AS #8 LEN=86 _  'Pe 03/13/92
  2554.         ELSE OPEN "R",8,ZDirPAth$ +"UPLOADLG.DEF",86                  'Pe 03/13/92
  2555.                    FIELD 8,84 AS ShowUp$, _
  2556.                    2 AS fill$
  2557.          RecordNum! = FIX(LOF(8) / 86)
  2558.         ZJumpSupported = ZTrue
  2559.        ZJumpSearching = ZFalse
  2560.       ZJumpLast$ = ""
  2561. 59502 If RecordNum! < 1 OR ZRet THEN  _
  2562.        GOTO 59560
  2563.         Get #8, RecordNum!
  2564.          ZOutTxt$ = ShowUp$
  2565.           RecordNum! = RecordNum! - 1
  2566.  
  2567. ' Do Not display Sysop only and Personall Uploads
  2568.  
  2569.  IF INSTR(ZOutTxt$,"*") > 0 and NOT ZSysop THEN _
  2570.           GOTO 59502
  2571.  
  2572.          GOSUB 59550
  2573.         GOTO 59502      
  2574.  
  2575. 59550   IF ZJumpSearching THEN _
  2576.           ZWasDF$ = ZOutTxt$ : _
  2577.            CALL AllCaps (ZWasDF$) : _
  2578.             IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  2579.                Return _
  2580.              ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  2581.               ZJumpSearching = ZFalse
  2582.              ZSubParm = 5
  2583.             CALL SmartText (ZOutTxt$,ZTrue,ZFalse,ZFalse)
  2584.            CALL Tput
  2585.           WasX=1
  2586.         CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2587.          IF ZNo OR ZSubParm = -1 THEN _
  2588.             ZJumpSupported = ZFalse : _
  2589.               ZJumpSearching = ZFalse : _
  2590.                ZJumpLast$ = "" : _
  2591.               Close 8 : _
  2592.            Exit Sub 
  2593.       Return
  2594. 59560 IF ZJumpSearching Then _
  2595.     Call GetRBBSString(120,RBBSString$) : _      'Pe 01/16/93
  2596.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2597.       Call QuickTput1 (OutTxt$)
  2598.       ZJumpSupported = ZFalse
  2599.       ZJumpSearching = ZFalse
  2600.       ZJumpLast$ = ""
  2601.       Close 8
  2602.      End Sub
  2603.